      include 'gplapncd.for'
C This code was written by the program
C <TABLO  Version 5.5   February 2005>
      use tgmnz
      use gpcm
      use gsinc1
      use gsinc3
      use gsinc4
      use gsinc5
      use gsinc5b
      use gsinc6
      use gsinc7
      use gsinc8
      use gscomp
      use TGSMVL
      use gpbas1
      use tgdebg
      use gpmain1
      use smvlst0
      use psimmod1
      use psimmod2
      USE SIMRES0
      use gtap_
      include 'tggsdec1.for'
      CHARACTER*70 PROGNV
      PARAMETER(PROGNV=
     *'<gtap.for 25-JUL-2007 (a TABLO-generated program)>')
      INTEGER PRVERI
      PARAMETER(PRVERI=34000)
      CHARACTER (LEN=9) DATES
      PARAMETER(DATES='1987-2005')
      CHARACTER*6 PRNAME
      PARAMETER(PRNAME='TGPROG')
      INTEGER DMMTOG
C Map from coefficient names in code to names in model specification
C
C      Name in code       Name used in model specification
C      ---------------------------------------------------
C         C00001            VERNUM
C         C00002            SIZE_TRAD
C         C00003            SIZE_ENDW
C         C00004            SIZE_DEMD
C         C00005            SIZE_CGDS
C         C00006            SIZE_PROD
C         C00007            SLUG
C         C00008            REGTOBLOC
C         C00009            SAVE
C         C00010            VDGA
C         C00011            VDGANC
C         C00012            VDGM
C         C00013            VIGA
C         C00014            VIGANC
C         C00015            VIGM
C         C00016            VDPA
C         C00017            VDPANC
C         C00018            VDPM
C         C00019            VIPA
C         C00020            VIPANC
C         C00021            VIPM
C         C00022            EVOA
C         C00023            EVFA
C         C00024            VDFA
C         C00025            VDFANC
C         C00026            VIFA
C         C00027            VIFANC
C         C00028            VFM
C         C00029            VIFM
C         C00030            VDFM
C         C00031            VDEP
C         C00032            VIMS
C         C00033            VIWS
C         C00034            VXWD
C         C00035            VXMD
C         C00036            VST
C         C00037            CO2DF
C         C00038            CO2IF
C         C00039            CO2DG
C         C00040            CO2IG
C         C00041            CO2DP
C         C00042            CO2IP
C         C00043            NCTAXLEV
C         C00044            VFAD
C         C00045            VOA
C         C00046            VDM
C         C00047            VOM
C         C00048            VGA
C         C00049            GOVEXP
C         C00050            VPA
C         C00051            PRIVEXP
C         C00052            INCOME
C         C00053            DFTAX
C         C00054            DFCTAX
C         C00055            IFTAX
C         C00056            IFCTAX
C         C00057            TIU
C         C00058            DPTAX
C         C00059            DPCTAX
C         C00060            IPTAX
C         C00061            IPCTAX
C         C00062            TPC
C         C00063            DGTAX
C         C00064            DGCTAX
C         C00065            IGTAX
C         C00066            IGCTAX
C         C00067            TGC
C         C00068            ETAX
C         C00069            TFU
C         C00070            PTAX
C         C00071            TOUT
C         C00072            XTAXD
C         C00073            TEX
C         C00074            MTAX
C         C00075            TIM
C         C00076            ESUBD
C         C00077            REGINV
C         C00078            NETINV
C         C00079            GLOBINV
C         C00080            CONSHR
C         C00081            INCPAR
C         C00082            UELASPRIV
C         C00083            CO2
C         C00084            CO2T
C         C00085            CO2TB
C         C00086            SHVDGANC
C         C00087            CO2DGVDGA
C         C00088            SHVIGANC
C         C00089            CO2IGVIGA
C         C00090            GMSHR
C         C00091            XWCONSHR
C         C00092            SUBPAR
C         C00093            ALPHA
C         C00094            APE
C         C00095            EY
C         C00096            EP
C         C00097            SHVDPANC
C         C00098            CO2DPVDPA
C         C00099            SHVIPANC
C         C00100            CO2IPVIPA
C         C00101            PMSHR
C         C00102            VFA
C         C00103            VFAS
C         C00104            SHVDFANC
C         C00105            CO2DFVDFA
C         C00106            SHVIFANC
C         C00107            CO2IFVIFA
C         C00108            FMSHR
C         C00109            SIZE_NCOAL
C         C00110            CSHNCOAL
C         C00111            ELNCOAL
C         C00112            SIZE_FUEL
C         C00113            CSHNELY
C         C00114            ELNEL
C         C00115            SIZE_ENY
C         C00116            CSHENY
C         C00117            ELEN
C         C00118            SIZE_KEN
C         C00119            CSHKEN
C         C00120            ELKE
C         C00121            SIZE_VAEN
C         C00122            CSHVAEN
C         C00123            ESUBVA
C         C00124            ESUBT
C         C00125            VFATOT
C         C00126            SIZE_TOP
C         C00127            CSHTOP
C         C00128            VKB
C         C00129            INVKERATIO
C         C00130            GRNETRATIO
C         C00131            RORFLEX
C         C00132            RORDELTA
C         C00133            MSHRS
C         C00134            ESUBM
C         C00135            VTMFSD
C         C00136            VTFSD
C         C00137            VTMUSE
C         C00138            VTMPROV
C         C00139            VTRPROV
C         C00140            VT
C         C00141            VTMUSESHR
C         C00142            VTSUPPSHR
C         C00143            VTUSE
C         C00144            VTFSD_MSH
C         C00145            VIWSCOST
C         C00146            FOBSHR
C         C00147            TRNSHR
C         C00148            CO2Q
C         C00149            CO2QB
C         C00150            XSHRPRIV
C         C00151            XSHRGOV
C         C00152            XSHRSAVE
C         C00153            VCTAX
C         C00154            TINC
C         C00155            REVSHR
C         C00156            ETRAE
C         C00157            PIND
C         C00158            INCOMEB
C         C00159            PINDB
C         C00160            NCTAXLEVB
C         C00161            CO2_L
C         C00162            NOMCTAX_L
C         C00163            FY
C         C00164            INDTAX
C         C00165            DPARSUM
C         C00166            UTILELAS
C         C00167            DPARPRIV
C         C00168            DPARGOV
C         C00169            DPARSAVE
C         C00170            UTILPRIV
C         C00171            UTILGOV
C         C00172            UTILSAVE
C         C00173            SHRDFM
C         C00174            SHRDPM
C         C00175            SHRDGM
C         C00176            SHRDM
C         C00177            SHRST
C         C00178            SHRXMD
C         C00179            VIM
C         C00180            SHRIFM
C         C00181            SHRIPM
C         C00182            SHRIGM
C         C00183            SHREM
C         C00184            VXW
C         C00185            VXWREGION
C         C00186            VIW
C         C00187            VIWREGION
C         C00188            VENDWREG
C         C00189            VENDWWLD
C         C00190            GDP
C         C00191            VXWCOMMOD
C         C00192            VXWLD
C         C00193            VIWCOMMOD
C         C00194            PW_PM
C         C00195            VOW
C         C00196            VWOW
C         C00197            VWOU
C         C00198            TBAL
C         C00199            TOTDEM
C         C00200            INCOMEEV
C         C00201            UTILPRIVEV
C         C00202            UTILGOVEV
C         C00203            UTILSAVEEV
C         C00204            VPAEV
C         C00205            VPAREGEV
C         C00206            CONSHREV
C         C00207            EYEV
C         C00208            UELASPRIVEV
C         C00209            XWCONSHREV
C         C00210            PRIVEXPEV
C         C00211            GOVEXPEV
C         C00212            SAVEEV
C         C00213            XSHRPRIVEV
C         C00214            XSHRGOVEV
C         C00215            XSHRSAVEEV
C         C00216            UTILELASEV
C         C00217            EVSCALFACT
C         C00218            VTMD
C         C00219            SX_IR
C         C00220            VTICOMM
C         C00221            VIWDIRALL
C         C00222            VIWDATOT
C         C00223            SM_IR
C         C00224            SX_IRS
C         C00225            SXT_IR
C         C00226            SM_IRS
C         C00227            SMT_IR
C         C00228            SW_IR
C         C00229            SW_I
C         C00230            C00230
C         C00231            C00231
C         C00232            C00232
C         C00233            C00233
C         C00234            C00234
C         C00235            C00235
C         C00236            C00236
C         C00237            C00237
C         C00238            C00238
C         C00239            C00239
C         C00240            C00240
C         C00241            C00241
C         C00242            C00242
C         C00243            C00243
C         C00244            C00244
C         C00245            C00245
C         C00246            C00246
C         C00247            C00247
C         C00248            C00248
C         C00249            C00249
C         C00250            C00250
C         C00251            C00251
C         C00252            C00252
C         C00253            C00253
C         C00254            C00254
C         C00255            C00255
C         C00256            C00256
C         C00257            C00257
C         C00258            C00258
C         C00259            C00259
C         C00260            C00260
C         C00261            C00261
C         C00262            C00262
C         C00263            C00263
C         C00264            C00264
C         C00265            C00265
C         C00266            C00266
C         C00267            C00267
C         C00268            C00268
C         C00269            C00269
C         C00270            C00270
C         C00271            C00271
C         C00272            C00272
C         C00273            C00273
C         C00274            C00274
C         C00275            C00275
C         C00276            C00276
C         C00277            C00277
C         C00278            C00278
C         C00279            C00279
C         C00280            C00280
C         C00281            C00281
C         C00282            C00282
C         C00283            C00283
C         C00284            C00284
C         C00285            C00285
C         C00286            C00286
C         C00287            C00287
C         C00288            C00288
C         C00289            C00289
C         C00290            C00290
C         C00291            C00291
C         C00292            C00292
C         C00293            C00293
C         C00294            C00294
C         C00295            C00295
C         C00296            C00296
C         C00297            C00297
C         C00298            C00298
C         C00299            C00299
C         C00300            C00300
C         C00301            C00301
C         C00302            C00302
C         C00303            C00303
C         C00304            C00304
C         C00305            C00305
C         C00306            C00306
C         C00307            C00307
C         C00308            C00308
C         C00309            C00309
C         C00310            C00310
C         C00311            C00311
C         C00312            C00312
C         C00313            C00313
C         C00314            C00314
C         C00315            C00315
C         C00316            C00316
C         C00317            C00317
C         C00318            C00318
C         C00319            C00319
C         C00320            C00320
C         C00321            C00321
C         C00322            C00322
C         C00323            C00323
C         C00324            C00324
C         C00325            C00325
C         C00326            C00326
C         C00327            C00327
C         C00328            C00328
C         C00329            C00329
C         C00330            C00330
C         C00331            C00331
C         C00332            C00332
C         C00333            C00333
C         C00334            C00334
C         C00335            C00335
C         C00336            C00336
C         C00337            C00337
C         C00338            C00338
C         C00339            C00339
C         C00340            C00340
C         C00341            C00341
C         C00342            C00342
C         C00343            C00343
C         C00344            C00344
C         C00345            C00345
C         C00346            C00346
C         C00347            C00347
C         C00348            C00348
C         C00349            C00349
C         C00350            C00350
C         C00351            C00351
C         C00352            C00352
C         C00353            C00353
C         C00354            C00354
C         C00355            C00355
C         C00356            C00356
C         C00357            C00357
C         C00358            C00358
C         C00359            C00359
C         C00360            C00360
C         C00361            C00361
C         C00362            C00362
C         C00363            C00363
C         C00364            C00364
C         C00365            C00365
C         C00366            C00366
C         C00367            C00367
C         C00368            C00368
C         C00369            C00369
C         C00370            C00370
C         C00371            C00371
C         C00372            C00372
C         C00373            C00373
C
C Declarations of all coefficients
C      REAL C00001(1),C00002(1),C00003(1),C00004(1),C00005(1),C00006(1)
C      INTEGER C00007(0),C00008(0)
C      REAL C00009(0),C00010(0,0),C00011(0,0),C00012(0,0),C00013(0,0)
C      REAL C00014(0,0),C00015(0,0),C00016(0,0),C00017(0,0),C00018(0,0)
C      REAL C00019(0,0),C00020(0,0),C00021(0,0),C00022(0,0)
C      REAL C00023(0,0,0),C00024(0,0,0),C00025(0,0,0),C00026(0,0,0)
C      REAL C00027(0,0,0),C00028(0,0,0),C00029(0,0,0),C00030(0,0,0)
C      REAL C00031(0),C00032(0,0,0),C00033(0,0,0),C00034(0,0,0)
C      REAL C00035(0,0,0),C00036(0,0),C00037(0,0,0),C00038(0,0,0)
C      REAL C00039(0,0),C00040(0,0),C00041(0,0),C00042(0,0),C00043(0)
C      REAL C00044(0,0,0),C00045(0,0),C00046(0,0),C00047(0,0)
C      REAL C00048(0,0),C00049(0),C00050(0,0),C00051(0),C00052(0)
C      REAL C00053(0,0,0),C00054(0,0,0),C00055(0,0,0),C00056(0,0,0)
C      REAL C00057(0),C00058(0,0),C00059(0,0),C00060(0,0),C00061(0,0)
C      REAL C00062(0),C00063(0,0),C00064(0,0),C00065(0,0),C00066(0,0)
C      REAL C00067(0),C00068(0,0,0),C00069(0),C00070(0,0),C00071(0)
C      REAL C00072(0,0,0),C00073(0),C00074(0,0,0),C00075(0),C00076(0)
C      REAL C00077(0),C00078(0),C00079(1),C00080(0,0),C00081(0,0)
C      REAL C00082(0),C00083(0,0),C00084(0),C00085(0),C00086(0,0)
C      REAL C00087(0,0),C00088(0,0),C00089(0,0),C00090(0,0),C00091(0,0)
C      REAL C00092(0,0),C00093(0,0),C00094(0,0,0),C00095(0,0)
C      REAL C00096(0,0,0),C00097(0,0),C00098(0,0),C00099(0,0)
C      REAL C00100(0,0),C00101(0,0),C00102(0,0,0),C00103(5,0,0)
C      REAL C00104(0,0,0),C00105(0,0,0),C00106(0,0,0),C00107(0,0,0)
C      REAL C00108(0,0,0),C00109(1),C00110(3,0,0),C00111(0,0),C00112(1)
C      REAL C00113(2,0,0),C00114(0,0),C00115(1),C00116(2,0,0)
C      REAL C00117(0,0),C00118(1),C00119(2,0,0),C00120(0,0),C00121(1)
C      REAL C00122(4,0,0),C00123(0,0),C00124(0),C00125(0,0),C00126(1)
C      REAL C00127(4,0,0),C00128(0),C00129(0),C00130(0),C00131(0)
C      INTEGER C00132(1)
C      REAL C00133(0,0,0),C00134(0),C00135(0,0,0,0),C00136(0,0,0)
C      REAL C00137(0),C00138(0),C00139(0),C00140(1),C00141(0,0,0,0)
C      REAL C00142(0,0),C00143(1),C00144(0,0,0,0),C00145(0,0,0)
C      REAL C00146(0,0,0),C00147(0,0,0),C00148(0),C00149(0),C00150(0)
C      REAL C00151(0),C00152(0),C00153(0,4),C00154(0),C00155(0,0,0)
C      REAL C00156(0),C00157(0),C00158(0),C00159(0),C00160(0)
C      REAL C00161(0,4),C00162(0),C00163(0),C00164(0),C00165(0)
C      REAL C00166(0),C00167(0),C00168(0),C00169(0),C00170(0),C00171(0)
C      REAL C00172(0),C00173(0,0,0),C00174(0,0),C00175(0,0),C00176(0,0)
C      REAL C00177(0,0),C00178(0,0,0),C00179(0,0),C00180(0,0,0)
C      REAL C00181(0,0),C00182(0,0),C00183(0,0,0),C00184(0,0),C00185(0)
C      REAL C00186(0,0),C00187(0),C00188(0),C00189(1),C00190(0)
C      REAL C00191(0),C00192(1),C00193(0),C00194(0,0),C00195(0,0)
C      REAL C00196(0),C00197(0),C00198(0),C00199(5,0),C00200(0)
C      REAL C00201(0),C00202(0),C00203(0),C00204(0,0),C00205(0)
C      REAL C00206(0,0),C00207(0,0),C00208(0),C00209(0,0),C00210(0)
C      REAL C00211(0),C00212(0),C00213(0),C00214(0),C00215(0),C00216(0)
C      REAL C00217(0),C00218(0,0),C00219(0,0),C00220(0,0),C00221(0,0)
C      REAL C00222(0),C00223(0,0),C00224(0,0,0),C00225(0,0)
C      REAL C00226(0,0,0),C00227(0,0),C00228(0,0),C00229(0),C00230(0)
C      REAL C00231(0,0),C00232(0,0),C00233(0),C00234(0,0),C00235(0,0)
C      REAL C00236(0),C00237(0),C00238(0),C00239(0),C00240(0,0)
C      REAL C00241(0,0),C00242(0,0),C00243(0,0),C00244(0),C00245(0)
C      REAL C00246(0,0),C00247(0,0),C00248(0),C00249(0),C00250(0)
C      REAL C00251(0,0),C00252(0,0),C00253(0),C00254(0),C00255(0)
C      REAL C00256(0),C00257(0,0),C00258(0),C00259(0),C00260(0,0)
C      REAL C00261(0),C00262(0),C00263(0,0),C00264(0,0),C00265(0)
C      REAL C00266(0),C00267(0),C00268(0,0),C00269(0),C00270(0)
C      REAL C00271(0),C00272(0,0),C00273(0),C00274(0),C00275(0)
C      REAL C00276(0,0),C00277(0),C00278(5,0),C00279(5,0),C00280(5,0)
C      REAL C00281(5,0),C00282(0,0),C00283(0,0),C00284(0),C00285(0,0)
C      REAL C00286(0,0),C00287(5,0),C00288(5,0),C00289(5,0),C00290(5,0)
C      REAL C00291(0,0),C00292(0),C00293(0,0),C00294(0),C00295(0)
C      REAL C00296(0,0),C00297(0,0),C00298(0,0),C00299(0,0),C00300(0)
C      REAL C00301(0),C00302(0,0),C00303(0,0),C00304(0,0),C00305(0,0)
C      REAL C00306(0,0),C00307(0,0),C00308(0,0),C00309(0,0),C00310(0)
C      REAL C00311(0,0),C00312(0,0),C00313(0),C00314(0,0),C00315(0)
C      REAL C00316(0,0),C00317(0,0),C00318(0,0),C00319(0,0),C00320(0,0)
C      REAL C00321(0,0),C00322(0,0),C00323(0,0),C00324(0,0),C00325(0,0)
C      REAL C00326(0,0),C00327(0,0),C00328(0,0),C00329(0,0),C00330(0,0)
C      REAL C00331(0,0),C00332(0,0),C00333(0),C00334(0,0),C00335(0,0)
C      REAL C00336(0,0),C00337(0,0),C00338(0,0),C00339(0),C00340(0,0)
C      REAL C00341(0,0),C00342(0,0),C00343(0,0,0),C00344(0,0)
C      REAL C00345(0,0),C00346(0,0),C00347(0),C00348(0,0),C00349(0,0)
C      REAL C00350(0,0),C00351(0),C00352(0,0,0),C00353(0,0)
C      REAL C00354(0,0,0),C00355(0,0),C00356(0,0),C00357(0,0)
C      REAL C00358(0,0),C00359(0),C00360(0,0),C00361(0,0),C00362(0,0)
C      REAL C00363(0,0),C00364(0),C00365(0,0),C00366(0,0),C00367(0,0)
C      REAL C00368(0,0),C00369(0),C00370(0,0),C00371(0,0,0),C00372(0,0)
C      REAL C00373(0,0,0)
C Finish of declarations of all coefficients
C Map from index names in code to names in model specification
C
C      Name in code       Name used in model specification
C      ---------------------------------------------------
C         I00001            i
C         I00002            r
C         I00003            s
C         I00004            j
C         I00005            m
C         I00006            b
C         I00007            h
C         I00008            k
C         I00009            n
C         I00010            l
C         I00011            XX01
      istgprog=.TRUE.
      isgemsim=.NOT.istgprog
      dmmtog=0
      mxgsrs=0
      mxgsis=0
      mxgslg=0
      mxgsop=0
      mxgsin=0
      mxgsrc=0
      mxgsic=0
      AXSFIL='gtap'
      AXTFIL=AXSFIL
      include 'tggscod1.for'
      include 'tggscod2.for'
      include 'tggscod3.for'
200    CONTINUE
      include 'tggscod4.for'
      CALL M00001(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00002(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00003(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00004(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00005(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF((DOEQ.OR.DOCLOS.OR.WRSVI).AND.FSTPAS
     *     .AND.NOXSS.AND. .NOT.SZENDN) THEN
      include 'tggsen1.for'
      END IF
      IF(KSINTA.EQ.1.AND.(PGDSIM.OR.DOSHCK).AND.FSTPAS.AND.NOXSSW
     *    .AND.(.NOT.SHDONE).AND.(.NOT.ABTSIM).AND.(.NOT.ISFNLV)) THEN
      include 'tggsshk1.for'
      END IF
      IF(.NOT.DOCBC) GOTO 3000
      CALL M00006(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00007(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00008(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00009(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00010(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00011(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      LSACTP='1'
      LSACNO=0
      IF(EXSUSE) THEN
        CALL GPREW(EXSUN,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
1000  CONTINUE
      IF((DOEQ.OR.DOCLOS.OR.WRSVI).AND.FSTPAS.AND. .NOT.SZENDN) THEN
       IF(DIDPRE.OR.(LSACTP.EQ.ENACTP.AND.ENACNO.EQ.LSACNO)) THEN
      include 'tggsen1.for'
       END IF
      END IF
      IF(KSINTA.EQ.1.AND.(PGDSIM.OR.DOSHCK).AND.FSTPAS.AND.
     *    (.NOT.SHDONE).AND.(.NOT.ABTSIM)) THEN
       IF(ISFNLV.OR.(LSACTP.EQ.SHACTP.AND.LSACNO.GE.SHACNO)) THEN
      include 'tggsshk1.for'
       END IF
      END IF
      IF(.NOT.DOCBC) GOTO 3000
      include 'tgdeac3t.for'
      include 'tggscod5.for'
      include 'tggscod6.for'
      IF(.NOT.DOEQ) GOTO 8100
      include 'tggscod7.for'
 360  CONTINUE
      include 'tggscod8.for'
      CALL M00012(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00013(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00014(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00015(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00016(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00017(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00018(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00019(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00020(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00021(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00022(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00023(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00024(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00025(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00026(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00027(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00028(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPCPU(XX8,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(RCPU) THEN
        CALL GPTOG('t',0, '[CPU for %t is %r seconds.]',
     *    '\x','\x','equations',' ',' ',0,0,XX8-XX7,0.0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
        CALL GPTOG('t',0, '[CPU for formulas and %s is %r seconds.]',
     *    '\x','\x','equations',' ',' ',0,0,XX8-XX4,0.0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(MCOSHM) THEN
       CALL ALLMCO1(1,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGWDMSTSOL(TBCOL,DEBG(123),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
3000  CONTINUE
      CALL GPCPU(XX9,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      include 'tggssim0.for'
 3010 CONTINUE
      include 'tggseqb1.for'
 3380 CONTINUE
      include 'tggsbs1.for'
      CALL M00029(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  CWKUN,
     *  FSTPAS,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00030(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  CWKUN,
     *  FSTPAS,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00031(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  CWKUN,
     *  FSTPAS,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SSVFTS('t',NUMVC,VCSTAT,DSMRES,SIMRES,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      include 'tggsbs2.for'
4000  continue
      include 'tggsud0.for'
      CALL POSFIL(AXSUN,'BUPD',TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CONTSI=.TRUE.
      CALL M00032(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,RTSIOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,NELTX,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) GOTO 8260
      CALL M00033(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,RTSIOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,NELTX,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) GOTO 8260
      CALL M00034(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,RTSIOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,NELTX,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) GOTO 8260
      include 'tggsud1.for'
 8260 CONTINUE
      include 'tggsud2.for'
      GOTO 5900
5850  CONTINUE
      include 'tggspre1.for'
      include 'tggspre2.for'
      include 'tggsei0.for'
      include 'tggsudx1.for'
 8300 CONTINUE
      include 'tggsei1.for'
8360  CONTINUE
      include 'tggsecp1.for'
      include 'tggsend1.for'
8100  CONTINUE
      include 'tggsend2.for'
9000  CONTINUE
      include 'tggsend3.for'
      END
      SUBROUTINE S00001(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00002,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00002(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_TRAD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(2)
      RS1=RS1+1
    1 CONTINUE
      C00002(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_TRAD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00001')
      RETURN
      END
      SUBROUTINE S00002(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00003,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00003(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_ENDW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(6)
      RS1=RS1+1
    1 CONTINUE
      C00003(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_ENDW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00002')
      RETURN
      END
      SUBROUTINE S00003(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00004,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00004(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_DEMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(8)
      RS1=RS1+1
    1 CONTINUE
      C00004(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_DEMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00003')
      RETURN
      END
      SUBROUTINE S00004(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00002,C00003,C00004,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER ASSVAL,MMEL,ELAD(MMNST)
      LOGICAL ASSOK
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00002(1)
      REAL C00003(1)
      REAL C00004(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating assertion',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      ASSOK=.TRUE.
      RS1=0.0
      LG1=C00004(1).EQ.C00002(1)+C00003(1)
      IF(LG1) THEN
      RS1=1
      END IF
      ASSVAL=RS1
      IF(ASSVAL.NE.1) THEN
        CALL TGASF1(ASSOK,0,
     *' ',
     *    0,0,0,0,0,0,0,
     *    0,0,0,0,0,0,0,
     *  MMNST,ELAD,STELST,STNM,MMEL,STEL,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
        ASSOK=.FALSE.
      END IF
      IF(.NOT.ASSOK) THEN
       CALL TGASFCV('tg',31,
     *' ',
     *   ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
       CALL TGASF2(
     *' ',
     *   ASSOK,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating assertion',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00004')
      RETURN
15500 CALL PERETM('S00004',ERRMES)
      RETURN
      END
      SUBROUTINE S00005(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00005,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00005(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_CGDS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(5)
      RS1=RS1+1
    1 CONTINUE
      C00005(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_CGDS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00005')
      RETURN
      END
      SUBROUTINE S00006(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00006,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00006(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_PROD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(7)
      RS1=RS1+1
    1 CONTINUE
      C00006(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_PROD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00006')
      RETURN
      END
      SUBROUTINE S00007(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00002,C00005,C00006,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER ASSVAL,MMEL,ELAD(MMNST)
      LOGICAL ASSOK
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00002(1)
      REAL C00005(1)
      REAL C00006(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating assertion',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      ASSOK=.TRUE.
      RS1=0.0
      LG1=C00006(1).EQ.C00002(1)+C00005(1)
      IF(LG1) THEN
      RS1=1
      END IF
      ASSVAL=RS1
      IF(ASSVAL.NE.1) THEN
        CALL TGASF1(ASSOK,0,
     *' ',
     *    0,0,0,0,0,0,0,
     *    0,0,0,0,0,0,0,
     *  MMNST,ELAD,STELST,STNM,MMEL,STEL,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
        ASSOK=.FALSE.
      END IF
      IF(.NOT.ASSOK) THEN
       CALL TGASFCV('tg',36,
     *' ',
     *   ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
       CALL TGASF2(
     *' ',
     *   ASSOK,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating assertion',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00007')
      RETURN
15500 CALL PERETM('S00007',ERRMES)
      RETURN
      END
      SUBROUTINE S00008(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00007,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      INTEGER C00007(SSZ(6))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      LOGICAL RUNTSS,PRELIM,DOPRE,DIDPRE
      INTEGER NSSMP
      COMMON /TGPREI/DOPRE,PRELIM,DIDPRE
      COMMON /TGTPSI/NSSMP,RUNTSS
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for set:',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      IF((PRELIM.OR.POSTSIMPASS2).AND.RUNTSS) THEN
        SSMPST(10)=NSSMP+1
        CALL TGINCP(NSSMP+SSZ(6),DSSMP,'DSSMP',ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      DO 1 I00001=1,SSZ(6)
      RS1=0.0
      LG1=C00007(I00001).GT.0
      IF(LG1) THEN
      RS1=1
      END IF
      SSMP(SSMPST(10)-1+I00001)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for set:',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00008')
      RETURN
      END
      SUBROUTINE M00001(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(PRELIM) THEN
       CALL SSAL1C(1,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(2,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(3,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(4,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(5,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(6,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(79,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(109,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(112,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(115,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(118,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(121,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(126,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(132,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(140,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(143,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(189,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(192,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(8,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(9,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(31,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(43,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(49,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(51,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(52,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(57,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(62,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(67,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(69,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(71,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(73,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(75,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(77,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(78,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(82,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(84,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(128,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(129,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(130,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(131,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(139,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(148,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(150,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(151,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(152,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(154,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(157,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(162,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(163,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(164,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(165,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(166,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(167,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(168,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(169,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(170,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(171,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(172,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(185,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(187,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(188,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(190,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(198,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(200,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(201,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(202,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(203,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(205,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(208,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(210,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(211,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(212,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(213,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(214,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(215,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(216,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(217,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(222,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(230,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(233,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(236,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(237,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(238,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(239,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(244,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(245,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(248,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(249,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(250,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(253,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(254,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(255,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(256,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(258,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(259,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(261,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(262,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(265,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(266,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(267,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(269,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(270,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(271,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(273,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(274,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(275,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(277,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(284,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(292,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(294,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(295,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(300,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(301,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(310,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(313,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(315,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(333,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(346,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(347,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(350,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(351,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(358,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(359,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(363,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(364,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(368,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(369,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(10,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(11,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(12,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(13,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(14,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(15,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(16,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(17,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(18,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(19,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(20,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(21,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(32,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(33,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(34,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(35,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(39,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(40,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(41,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(42,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(46,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(48,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(50,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(58,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(59,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(60,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(61,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(63,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(64,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(65,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(66,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(72,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(74,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(76,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(80,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(81,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(83,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(86,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(87,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(88,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(89,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(90,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(91,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(92,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(93,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(94,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(95,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(96,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(97,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(98,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(99,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(100,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(101,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(133,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(134,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(136,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(145,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(146,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(147,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(174,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(175,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(176,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(178,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(179,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(181,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(182,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(184,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(186,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(191,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(193,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(194,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(195,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(196,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(197,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(204,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(206,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(207,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(209,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(219,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(221,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(223,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(224,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(226,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(228,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(229,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(231,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(232,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(234,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(235,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(240,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(241,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(242,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(243,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(246,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(247,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(251,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(252,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(257,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(260,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(263,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(264,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(268,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(272,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(276,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(282,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(283,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(285,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(286,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(291,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(293,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(296,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(297,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(298,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(299,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(318,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(319,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(320,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(321,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(322,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(323,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(324,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(329,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(330,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(331,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(332,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(338,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(343,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(345,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(349,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(353,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(355,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(357,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(362,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(367,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(372,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(36,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(135,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(137,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(138,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(141,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(142,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(144,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(177,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(218,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(220,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(225,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(227,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(325,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(326,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(334,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(335,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(339,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(340,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(341,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(342,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(344,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(348,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(352,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(354,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(356,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(360,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(361,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(365,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(366,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(370,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(371,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(373,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=3
       SSNO=1
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,1,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(327,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(328,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(336,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(337,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=4
       SSNO=2
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,2,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(7,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(22,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(156,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(316,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(317,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(23,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(24,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(25,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(26,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(27,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(28,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(29,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(30,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(37,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(38,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(53,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(54,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(55,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(56,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(68,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(104,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(105,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(106,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(107,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(108,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(111,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(114,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(117,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(120,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(123,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(124,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(125,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(155,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(173,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(180,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(302,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(303,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(304,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(305,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(306,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(307,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(309,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(312,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=2
       SSNO=3
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,3,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=5
       SSNO=4
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,4,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(44,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=6
       SSNO=5
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,5,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=2
       SSNO=6
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,6,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(45,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(47,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(70,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=8
       SSNO=7
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,7,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=5
       SSNO=8
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,8,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=7
       SSNO=9
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,9,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(26).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_TRAD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(26).NE.'n') then
      CALL S00001(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(26),
     *  C00002,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(28).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_ENDW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(28).NE.'n') then
      CALL S00002(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(28),
     *  C00003,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(30).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_DEMD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(30).NE.'n') then
      CALL S00003(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(30),
     *  C00004,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(31).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
      CALL GPTO(' Assertion',ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(31).NE.'n') then
      CALL S00004(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(31),
     *  C00002,C00003,C00004,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      IF(ECHO1.AND.DOIG(33).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_CGDS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(33).NE.'n') then
      CALL S00005(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(33),
     *  C00005,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(35).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_PROD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(35).NE.'n') then
      CALL S00006(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(35),
     *  C00006,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(36).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
      CALL GPTO(' Assertion',ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(36).NE.'n') then
      CALL S00007(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(36),
     *  C00002,C00005,C00006,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(40).EQ.'y') THEN
        CALL GPTO1(' Formula for set ''%t''',
     *    'ENDWS_COMM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(40).NE.'n') then
      CALL S00008(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(40),
     *  C00007,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=10
       SSNO=10
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,10,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(183,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(314,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=11
       SSNO=11
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,11,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=12
       SSNO=12
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,12,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(199,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(278,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(279,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(280,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(281,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(287,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(288,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(289,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(290,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=13
       SSNO=13
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,13,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(153,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(161,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=14
       SSNO=14
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,14,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(85,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(149,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(158,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(159,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(160,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.FSTPAS) THEN
        CALL TGRMPE(3,'MAPB',SSZ(1),SSZ(15),
     *    SSZ(1),'REGTOBLOC   ','REG         ','BLOC        ',
     *    SIZE(C00008),C00008,1,MMEL,STEL,ELAD(15),ELAD(1),
     *  0,1,1,1,1,1,1,
     *  '            ',' ',' ',
     *  DSSMP,SSMP,MMNSS,SSMPST,SSIOS,
     *   RDUN,LFNORD,RDFSNO,MMNFL,AFN,AFS,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00001')
      RETURN
      END
      SUBROUTINE S00009(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00023,C00044,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00023(SSZ(6),SSZ(7),SSZ(1))
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(6)
      C00044(SSMP(SSMPST(5)-1+I00001),I00004,I00002)=
     *  C00023(I00001,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFAD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00009')
      RETURN
      END
      SUBROUTINE S00010(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00024,C00026,C00044,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)=
     *  C00024(I00001,I00004,I00003)+C00026(I00001,I00004,I00003)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFAD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00010')
      RETURN
      END
      SUBROUTINE S00011(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00022,C00045,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00022(SSZ(6),SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(6)
      C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)=
     *  C00022(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00011')
      RETURN
      END
      SUBROUTINE S00012(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00044,C00045,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(7)
      RS1=0.0
      DO 3 I00004=1,SSZ(8)
      RS1=RS1+C00044(I00004,I00001,I00002)
    3 CONTINUE
      C00045(SSMP(SSMPST(9)-1+I00001),I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00012')
      RETURN
      END
      SUBROUTINE S00013(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00012,C00018,C00030,C00046,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00012(SSZ(2),SSZ(1))
      REAL C00018(SSZ(2),SSZ(1))
      REAL C00030(SSZ(2),SSZ(7),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VDM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00030(I00001,I00004,I00002)
    3 CONTINUE
      C00046(I00001,I00002)=C00018(I00001,I00002)+C00012(I00001,I00002)+
     *  RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VDM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00013')
      RETURN
      END
      SUBROUTINE S00014(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00028,C00047,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00028(SSZ(6),SSZ(7),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(6)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00028(I00001,I00004,I00002)
    3 CONTINUE
      C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00014')
      RETURN
      END
      SUBROUTINE S00015(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00035,C00036,C00046,C00047,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00035(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005))),I00002)=C00046(SSMP(SSMPST(1)-1+I00005),I00002)+RS1+
     *  C00036(I00005,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00015')
      RETURN
      END
      SUBROUTINE S00016(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00035,C00046,C00047,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00035(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001))),I00002)=C00046(SSMP(SSMPST(2)-1+I00001),I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00016')
      RETURN
      END
      SUBROUTINE S00017(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00045,C00047,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00007
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00007=1,SSZ(5)
      C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)=
     *  C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00017')
      RETURN
      END
      SUBROUTINE S00018(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00010,C00013,C00048,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00048(I00001,I00003)=C00010(I00001,I00003)+C00013(I00001,I00003)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00018')
      RETURN
      END
      SUBROUTINE S00019(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GOVEXP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00048(I00001,I00002)
    2 CONTINUE
      C00049(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GOVEXP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00019')
      RETURN
      END
      SUBROUTINE S00020(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00016,C00019,C00050,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00050(I00001,I00003)=C00016(I00001,I00003)+C00019(I00001,I00003)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00020')
      RETURN
      END
      SUBROUTINE S00021(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00051,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00051(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PRIVEXP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00050(I00001,I00002)
    2 CONTINUE
      C00051(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PRIVEXP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00021')
      RETURN
      END
      SUBROUTINE S00022(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00009,C00049,C00051,C00052,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00051(SSZ(1))
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INCOME"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00052(I00002)=C00051(I00002)+C00049(I00002)+C00009(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "INCOME"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00022')
      RETURN
      END
      SUBROUTINE S00023(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00025,C00030,C00053,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00025(SSZ(2),SSZ(7),SSZ(1))
      REAL C00030(SSZ(2),SSZ(7),SSZ(1))
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DFTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      C00053(I00001,I00004,I00002)=C00025(I00001,I00004,I00002)-
     *  C00030(I00001,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DFTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00023')
      RETURN
      END
      SUBROUTINE S00024(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00024,C00025,C00054,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00025(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DFCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      C00054(I00001,I00004,I00002)=C00024(I00001,I00004,I00002)-
     *  C00025(I00001,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DFCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00024')
      RETURN
      END
      SUBROUTINE S00025(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00029,C00055,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00027(SSZ(2),SSZ(7),SSZ(1))
      REAL C00029(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IFTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      C00055(I00001,I00004,I00002)=C00027(I00001,I00004,I00002)-
     *  C00029(I00001,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "IFTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00025')
      RETURN
      END
      SUBROUTINE S00026(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00026,C00027,C00056,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00027(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IFCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      C00056(I00001,I00004,I00002)=C00026(I00001,I00004,I00002)-
     *  C00027(I00001,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "IFCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00026')
      RETURN
      END
      SUBROUTINE S00027(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00053,C00055,C00057,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00057(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TIU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00004=1,SSZ(7)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00053(I00001,I00004,I00002)+C00055(I00001,I00004,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    2 CONTINUE
      C00057(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TIU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00027')
      RETURN
      END
      SUBROUTINE S00028(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00017,C00018,C00058,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00017(SSZ(2),SSZ(1))
      REAL C00018(SSZ(2),SSZ(1))
      REAL C00058(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00058(I00001,I00002)=C00017(I00001,I00002)-C00018(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DPTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00028')
      RETURN
      END
      SUBROUTINE S00029(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00016,C00017,C00059,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00017(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00059(I00001,I00002)=C00016(I00001,I00002)-C00017(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DPCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00029')
      RETURN
      END
      SUBROUTINE S00030(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00020,C00021,C00060,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00020(SSZ(2),SSZ(1))
      REAL C00021(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IPTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00060(I00001,I00002)=C00020(I00001,I00002)-C00021(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "IPTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00030')
      RETURN
      END
      SUBROUTINE S00031(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00019,C00020,C00061,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00020(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IPCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00061(I00001,I00002)=C00019(I00001,I00002)-C00020(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "IPCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00031')
      RETURN
      END
      SUBROUTINE S00032(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00058,C00060,C00062,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00062(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TPC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00058(I00001,I00002)+C00060(I00001,I00002)
    2 CONTINUE
      C00062(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TPC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00032')
      RETURN
      END
      SUBROUTINE S00033(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00011,C00012,C00063,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00011(SSZ(2),SSZ(1))
      REAL C00012(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DGTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00063(I00001,I00002)=C00011(I00001,I00002)-C00012(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DGTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00033')
      RETURN
      END
      SUBROUTINE S00034(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00010,C00011,C00064,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00011(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DGCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00064(I00001,I00002)=C00010(I00001,I00002)-C00011(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DGCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00034')
      RETURN
      END
      SUBROUTINE M00002(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(227).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(227).NE.'n') then
      CALL S00009(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(227),
     *  C00023,C00044,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(228).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(228).NE.'n') then
      CALL S00010(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(228),
     *  C00024,C00026,C00044,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(230).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(230).NE.'n') then
      CALL S00011(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(230),
     *  C00022,C00045,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(231).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(231).NE.'n') then
      CALL S00012(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(231),
     *  C00044,C00045,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(233).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VDM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(233).NE.'n') then
      CALL S00013(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(233),
     *  C00012,C00018,C00030,C00046,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(235).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(235).NE.'n') then
      CALL S00014(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(235),
     *  C00028,C00047,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(236).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(236).NE.'n') then
      CALL S00015(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(236),
     *  C00035,C00036,C00046,C00047,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(237).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(237).NE.'n') then
      CALL S00016(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(237),
     *  C00035,C00046,C00047,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(238).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(238).NE.'n') then
      CALL S00017(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(238),
     *  C00045,C00047,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(240).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VGA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(240).NE.'n') then
      CALL S00018(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(240),
     *  C00010,C00013,C00048,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(242).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GOVEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(242).NE.'n') then
      CALL S00019(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(242),
     *  C00048,C00049,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(244).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(244).NE.'n') then
      CALL S00020(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(244),
     *  C00016,C00019,C00050,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(246).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PRIVEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(246).NE.'n') then
      CALL S00021(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(246),
     *  C00050,C00051,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(248).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(248).NE.'n') then
      CALL S00022(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(248),
     *  C00009,C00049,C00051,C00052,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(250).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DFTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(250).NE.'n') then
      CALL S00023(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(250),
     *  C00025,C00030,C00053,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(252).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DFCTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(252).NE.'n') then
      CALL S00024(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(252),
     *  C00024,C00025,C00054,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(254).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IFTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(254).NE.'n') then
      CALL S00025(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(254),
     *  C00027,C00029,C00055,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(256).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IFCTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(256).NE.'n') then
      CALL S00026(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(256),
     *  C00026,C00027,C00056,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(258).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TIU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(258).NE.'n') then
      CALL S00027(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(258),
     *  C00053,C00055,C00057,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(260).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(260).NE.'n') then
      CALL S00028(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(260),
     *  C00017,C00018,C00058,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(262).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPCTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(262).NE.'n') then
      CALL S00029(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(262),
     *  C00016,C00017,C00059,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(264).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IPTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(264).NE.'n') then
      CALL S00030(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(264),
     *  C00020,C00021,C00060,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(266).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IPCTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(266).NE.'n') then
      CALL S00031(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(266),
     *  C00019,C00020,C00061,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(268).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TPC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(268).NE.'n') then
      CALL S00032(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(268),
     *  C00058,C00060,C00062,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(270).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DGTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(270).NE.'n') then
      CALL S00033(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(270),
     *  C00011,C00012,C00063,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(272).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DGCTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(272).NE.'n') then
      CALL S00034(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(272),
     *  C00010,C00011,C00064,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00002')
      RETURN
      END
      SUBROUTINE S00035(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00014,C00015,C00065,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00014(SSZ(2),SSZ(1))
      REAL C00015(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IGTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00065(I00001,I00002)=C00014(I00001,I00002)-C00015(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "IGTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00035')
      RETURN
      END
      SUBROUTINE S00036(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00013,C00014,C00066,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00014(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IGCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00066(I00001,I00002)=C00013(I00001,I00002)-C00014(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "IGCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00036')
      RETURN
      END
      SUBROUTINE S00037(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00063,C00065,C00067,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00067(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TGC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00063(I00001,I00002)+C00065(I00001,I00002)
    2 CONTINUE
      C00067(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TGC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00037')
      RETURN
      END
      SUBROUTINE S00038(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00028,C00044,C00068,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00028(SSZ(6),SSZ(7),SSZ(1))
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "ETAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(6)
      C00068(I00001,I00004,I00002)=C00044(SSMP(SSMPST(5)-1+
     *  I00001),I00004,I00002)-C00028(I00001,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "ETAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00038')
      RETURN
      END
      SUBROUTINE S00039(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00068,C00069,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00069(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TFU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS2=0.0
      DO 2 I00001=1,SSZ(6)
      RS2=RS2+C00068(I00001,I00004,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00069(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TFU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00039')
      RETURN
      END
      SUBROUTINE S00040(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00045,C00047,C00070,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(9)
      C00070(I00001,I00002)=C00047(I00001,I00002)-C00045(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00040')
      RETURN
      END
      SUBROUTINE S00041(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00070,C00071,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00071(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TOUT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(7)
      RS1=RS1+C00070(SSMP(SSMPST(9)-1+I00001),I00002)
    2 CONTINUE
      C00071(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TOUT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00041')
      RETURN
      END
      SUBROUTINE S00042(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00035,C00072,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XTAXD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00072(I00001,I00002,I00003)=C00034(I00001,I00002,I00003)-
     *  C00035(I00001,I00002,I00003)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XTAXD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00042')
      RETURN
      END
      SUBROUTINE S00043(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00072,C00073,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00073(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TEX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2+C00072(I00001,I00002,I00003)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00073(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TEX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00043')
      RETURN
      END
      SUBROUTINE S00044(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00032,C00033,C00074,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "MTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00074(I00001,I00002,I00003)=C00032(I00001,I00002,I00003)-
     *  C00033(I00001,I00002,I00003)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "MTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00044')
      RETURN
      END
      SUBROUTINE S00045(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00074,C00075,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00075(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TIM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2+C00074(I00001,I00003,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00075(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TIM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00045')
      RETURN
      END
      SUBROUTINE S00046(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00045,C00077,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00077(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "REGINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00008=1,SSZ(5)
      RS1=RS1+C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00008)),I00002)
    2 CONTINUE
      C00077(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "REGINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00046')
      RETURN
      END
      SUBROUTINE S00047(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00031,C00045,C00078,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00078(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "NETINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00008=1,SSZ(5)
      RS1=RS1+C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00008)),I00002)
    2 CONTINUE
      C00078(I00002)=RS1-C00031(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "NETINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00047')
      RETURN
      END
      SUBROUTINE S00048(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00078,C00079,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00079(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GLOBINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00002=1,SSZ(1)
      RS1=RS1+C00078(I00002)
    1 CONTINUE
      C00079(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GLOBINV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00048')
      RETURN
      END
      SUBROUTINE S00049(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00080,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00080(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CONSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00008=1,SSZ(2)
      RS1=RS1+C00050(I00008,I00002)
    3 CONTINUE
      RS2=C00050(I00001,I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      C00080(I00001,I00002)=RS4
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CONSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00049')
      RETURN
      END
      SUBROUTINE S00050(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00080,C00081,C00082,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00080(SSZ(2),SSZ(1))
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00082(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UELASPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00080(I00001,I00002)*C00081(I00001,I00002)
    2 CONTINUE
      C00082(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UELASPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00050')
      RETURN
      END
      SUBROUTINE S00051(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00037,C00038,C00039,C00040,C00041,C00042,C00083,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00037(SSZ(2),SSZ(7),SSZ(1))
      REAL C00038(SSZ(2),SSZ(7),SSZ(1))
      REAL C00039(SSZ(2),SSZ(1))
      REAL C00040(SSZ(2),SSZ(1))
      REAL C00041(SSZ(2),SSZ(1))
      REAL C00042(SSZ(2),SSZ(1))
      REAL C00083(SSZ(1),SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00037(I00001,I00004,I00002)
    3 CONTINUE
      RS2=0.0
      DO 4 I00004=1,SSZ(7)
      RS2=RS2+C00038(I00001,I00004,I00002)
    4 CONTINUE
      C00083(I00002,I00001)=RS1+RS2+C00039(I00001,I00002)+
     *  C00040(I00001,I00002)+C00041(I00001,I00002)+
     *  C00042(I00001,I00002)
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CO2"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00051')
      RETURN
      END
      SUBROUTINE S00052(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00083,C00084,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00083(SSZ(1),SSZ(2))
      REAL C00084(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2T"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(14)
      RS1=RS1+C00083(I00002,SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+
     *  I00001)))
    2 CONTINUE
      C00084(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CO2T"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00052')
      RETURN
      END
      SUBROUTINE S00053(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00008,C00084,C00085,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00006
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00084(SSZ(1))
      REAL C00085(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2TB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00006=1,SSZ(15)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      LG1=C00008(I00002).EQ.I00006
      IF(.NOT.LG1) GOTO     2
      RS1=RS1+C00084(I00002)
    2 CONTINUE
      C00085(I00006)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CO2TB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00053')
      RETURN
      END
      SUBROUTINE S00054(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00010,C00011,C00086,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00011(SSZ(2),SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVDGANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00011(I00001,I00002)
      RS2=C00010(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00086(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHVDGANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00054')
      RETURN
      END
      SUBROUTINE S00055(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00010,C00039,C00087,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00039(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2DGVDGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00039(I00001,I00002)
      RS2=C00010(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00087(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CO2DGVDGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00055')
      RETURN
      END
      SUBROUTINE S00056(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00013,C00014,C00088,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00014(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVIGANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00014(I00001,I00002)
      RS2=C00013(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00088(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHVIGANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00056')
      RETURN
      END
      SUBROUTINE S00057(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00013,C00040,C00089,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00040(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2IGVIGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00040(I00001,I00002)
      RS2=C00013(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00089(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CO2IGVIGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00057')
      RETURN
      END
      SUBROUTINE S00058(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00013,C00048,C00090,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00013(I00001,I00003)
      RS2=C00048(I00001,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00090(I00001,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00058')
      RETURN
      END
      SUBROUTINE S00059(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00080,C00081,C00082,C00091,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00080(SSZ(2),SSZ(1))
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00082(SSZ(1))
      REAL C00091(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XWCONSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00080(I00001,I00002)*C00081(I00001,I00002)
      RS2=C00082(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00091(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XWCONSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00059')
      RETURN
      END
      SUBROUTINE S00060(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00092,C00093,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00092(SSZ(2),SSZ(1))
      REAL C00093(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "ALPHA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00093(I00001,I00002)=1  -C00092(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "ALPHA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00060')
      RETURN
      END
      SUBROUTINE S00061(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00080,C00093,C00094,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER I00009
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00080(SSZ(2),SSZ(1))
      REAL C00093(SSZ(2),SSZ(1))
      REAL C00094(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "APE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00008=1,SSZ(2)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 4 I00009=1,SSZ(2)
      RS1=RS1+C00080(I00009,I00002)*C00093(I00009,I00002)
    4 CONTINUE
      C00094(I00001,I00008,I00002)=C00093(I00001,I00002)+
     *  C00093(I00008,I00002)-RS1
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "APE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00061')
      RETURN
      END
      SUBROUTINE S00062(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00080,C00093,C00094,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00009
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00080(SSZ(2),SSZ(1))
      REAL C00093(SSZ(2),SSZ(1))
      REAL C00094(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "APE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00009=1,SSZ(2)
      RS1=RS1+C00080(I00009,I00002)*C00093(I00009,I00002)
    3 CONTINUE
      RS2=C00093(I00001,I00002)
      RS3=C00080(I00001,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      C00094(I00001,I00001,I00002)=2.0*C00093(I00001,I00002)-RS1-RS4
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "APE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00062')
      RETURN
      END
      SUBROUTINE S00063(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00080,C00081,C00093,C00095,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00009
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00080(SSZ(2),SSZ(1))
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00093(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00009=1,SSZ(2)
      RS1=RS1+C00080(I00009,I00002)*C00081(I00009,I00002)
    3 CONTINUE
      RS2=1.0
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS5=0.0
      DO 4 I00009=1,SSZ(2)
      RS5=RS5+C00080(I00009,I00002)*C00081(I00009,I00002)*
     *  C00093(I00009,I00002)
    4 CONTINUE
      RS6=0.0
      DO 5 I00009=1,SSZ(2)
      RS6=RS6+C00080(I00009,I00002)*C00093(I00009,I00002)
    5 CONTINUE
      C00095(I00001,I00002)=RS4*(C00081(I00001,I00002)*(1.0-
     *  C00093(I00001,I00002))+RS5)+C00093(I00001,I00002)-RS6
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "EY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00063')
      RETURN
      END
      SUBROUTINE S00064(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00096,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00008=1,SSZ(2)
      DO 1 I00001=1,SSZ(2)
      C00096(I00001,I00008,I00002)=0
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "EP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00064')
      RETURN
      END
      SUBROUTINE S00065(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00080,C00094,C00095,C00096,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00080(SSZ(2),SSZ(1))
      REAL C00094(SSZ(2),SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00008=1,SSZ(2)
      DO 1 I00001=1,SSZ(2)
      C00096(I00001,I00008,I00002)=(C00094(I00001,I00008,I00002)-
     *  C00095(I00001,I00002))*C00080(I00008,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "EP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00065')
      RETURN
      END
      SUBROUTINE S00066(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00016,C00017,C00097,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00017(SSZ(2),SSZ(1))
      REAL C00097(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVDPANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00017(I00001,I00002)
      RS2=C00016(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00097(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHVDPANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00066')
      RETURN
      END
      SUBROUTINE S00067(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00016,C00041,C00098,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00041(SSZ(2),SSZ(1))
      REAL C00098(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2DPVDPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00041(I00001,I00002)
      RS2=C00016(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00098(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CO2DPVDPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00067')
      RETURN
      END
      SUBROUTINE S00068(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00019,C00020,C00099,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00020(SSZ(2),SSZ(1))
      REAL C00099(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVIPANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00020(I00001,I00002)
      RS2=C00019(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00099(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHVIPANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00068')
      RETURN
      END
      SUBROUTINE S00069(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00019,C00042,C00100,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00042(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2IPVIPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00042(I00001,I00002)
      RS2=C00019(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00100(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CO2IPVIPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00069')
      RETURN
      END
      SUBROUTINE S00070(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00019,C00050,C00101,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00019(I00001,I00003)
      RS2=C00050(I00001,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00101(I00001,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00070')
      RETURN
      END
      SUBROUTINE S00071(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00024,C00025,C00104,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00025(SSZ(2),SSZ(7),SSZ(1))
      REAL C00104(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVDFANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      RS1=C00025(I00001,I00004,I00002)
      RS2=C00024(I00001,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00104(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHVDFANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00071')
      RETURN
      END
      SUBROUTINE S00072(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00024,C00037,C00105,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00037(SSZ(2),SSZ(7),SSZ(1))
      REAL C00105(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2DFVDFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      RS1=C00037(I00001,I00004,I00002)
      RS2=C00024(I00001,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00105(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CO2DFVDFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00072')
      RETURN
      END
      SUBROUTINE S00073(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00026,C00027,C00106,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00027(SSZ(2),SSZ(7),SSZ(1))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVIFANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      RS1=C00027(I00001,I00004,I00002)
      RS2=C00026(I00001,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00106(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHVIFANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00073')
      RETURN
      END
      SUBROUTINE S00074(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00026,C00038,C00107,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00038(SSZ(2),SSZ(7),SSZ(1))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2IFVIFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      RS1=C00038(I00001,I00004,I00002)
      RS2=C00026(I00001,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IER=4
      END IF
      C00107(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CO2IFVIFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00074')
      RETURN
      END
      SUBROUTINE S00075(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00026,C00044,C00108,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00108(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      RS1=C00026(I00001,I00004,I00003)
      RS2=C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00108(I00001,I00004,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FMSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00075')
      RETURN
      END
      SUBROUTINE S00076(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00044,C00102,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(8)
      C00102(SSMP(SSMPST(15)-1+I00001),I00004,I00002)=
     *  C00044(I00001,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00076')
      RETURN
      END
      SUBROUTINE M00003(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(ECHO1.AND.DOIG(274).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IGTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(274).NE.'n') then
      CALL S00035(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(274),
     *  C00014,C00015,C00065,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(276).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IGCTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(276).NE.'n') then
      CALL S00036(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(276),
     *  C00013,C00014,C00066,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(278).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TGC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(278).NE.'n') then
      CALL S00037(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(278),
     *  C00063,C00065,C00067,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(280).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'ETAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(280).NE.'n') then
      CALL S00038(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(280),
     *  C00028,C00044,C00068,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(282).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TFU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(282).NE.'n') then
      CALL S00039(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(282),
     *  C00068,C00069,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(284).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(284).NE.'n') then
      CALL S00040(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(284),
     *  C00045,C00047,C00070,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(286).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TOUT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(286).NE.'n') then
      CALL S00041(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(286),
     *  C00070,C00071,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(288).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XTAXD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(288).NE.'n') then
      CALL S00042(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(288),
     *  C00034,C00035,C00072,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(290).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TEX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(290).NE.'n') then
      CALL S00043(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(290),
     *  C00072,C00073,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(292).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'MTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(292).NE.'n') then
      CALL S00044(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(292),
     *  C00032,C00033,C00074,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(294).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TIM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(294).NE.'n') then
      CALL S00045(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(294),
     *  C00074,C00075,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(298).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'REGINV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(298).NE.'n') then
      CALL S00046(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(298),
     *  C00045,C00077,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(300).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NETINV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(300).NE.'n') then
      CALL S00047(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(300),
     *  C00031,C00045,C00078,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(302).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GLOBINV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(302).NE.'n') then
      CALL S00048(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(302),
     *  C00078,C00079,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(304).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CONSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(304).NE.'n') then
      CALL S00049(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(304),
     *  C00050,C00080,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(308).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UELASPRIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(308).NE.'n') then
      CALL S00050(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(308),
     *  C00080,C00081,C00082,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(310).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(310).NE.'n') then
      CALL S00051(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(310),
     *  C00037,C00038,C00039,C00040,C00041,C00042,C00083,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(312).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2T',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(312).NE.'n') then
      CALL S00052(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(312),
     *  C00083,C00084,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(FSTPAS.OR.PRELIM)THEN
      CALL TGCHMR(FSTPAS.OR.PRELIM,'REGTOBLOC   ',1,15,
     *  MMNST,SSZ,SSZ(1),C00008,1,
     *  '?','REG         ','BLOC        ',
     *  MMEL,STEL,ELAD(15)-1,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(PRELIM.OR.FSTPAS) THEN
       CALL SSRSMV(8,1,MMNST,SSZ,
     *   MMNCS,SMVLST,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(ECHO1.AND.DOIG(314).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2TB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(314).NE.'n') then
      CALL S00053(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(314),
     *  C00008,C00084,C00085,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(322).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVDGANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(322).NE.'n') then
      CALL S00054(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(322),
     *  C00010,C00011,C00086,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=0
      END IF
      IF(ECHO1.AND.DOIG(326).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2DGVDGA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(326).NE.'n') then
      CALL S00055(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(326),
     *  C00010,C00039,C00087,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(331).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVIGANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(331).NE.'n') then
      CALL S00056(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(331),
     *  C00013,C00014,C00088,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=0
      END IF
      IF(ECHO1.AND.DOIG(335).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2IGVIGA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(335).NE.'n') then
      CALL S00057(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(335),
     *  C00013,C00040,C00089,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(339).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GMSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(339).NE.'n') then
      CALL S00058(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(339),
     *  C00013,C00048,C00090,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(349).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XWCONSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(349).NE.'n') then
      CALL S00059(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(349),
     *  C00080,C00081,C00082,C00091,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(354).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'ALPHA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(354).NE.'n') then
      CALL S00060(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(354),
     *  C00092,C00093,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(356).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'APE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(356).NE.'n') then
      CALL S00061(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(356),
     *  C00080,C00093,C00094,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(357).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'APE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(357).NE.'n') then
      CALL S00062(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(357),
     *  C00080,C00093,C00094,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(359).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(359).NE.'n') then
      CALL S00063(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(359),
     *  C00080,C00081,C00093,C00095,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(361).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(361).NE.'n') then
      CALL S00064(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(361),
     *  C00096,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(362).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(362).NE.'n') then
      CALL S00065(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(362),
     *  C00080,C00094,C00095,C00096,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(369).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVDPANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(369).NE.'n') then
      CALL S00066(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(369),
     *  C00016,C00017,C00097,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=0
      END IF
      IF(ECHO1.AND.DOIG(373).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2DPVDPA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(373).NE.'n') then
      CALL S00067(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(373),
     *  C00016,C00041,C00098,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(380).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVIPANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(380).NE.'n') then
      CALL S00068(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(380),
     *  C00019,C00020,C00099,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=0
      END IF
      IF(ECHO1.AND.DOIG(384).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2IPVIPA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(384).NE.'n') then
      CALL S00069(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(384),
     *  C00019,C00042,C00100,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(389).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PMSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(389).NE.'n') then
      CALL S00070(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(389),
     *  C00019,C00050,C00101,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(103,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(102,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(308,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(311,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=8
       SSNO=15
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,15,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=16
       SSNO=16
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,16,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(411).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVDFANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(411).NE.'n') then
      CALL S00071(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(411),
     *  C00024,C00025,C00104,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=0
      END IF
      IF(ECHO1.AND.DOIG(415).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2DFVDFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(415).NE.'n') then
      CALL S00072(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(415),
     *  C00024,C00037,C00105,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(420).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVIFANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(420).NE.'n') then
      CALL S00073(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(420),
     *  C00026,C00027,C00106,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=0
      END IF
      IF(ECHO1.AND.DOIG(424).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2IFVIFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(424).NE.'n') then
      CALL S00074(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(424),
     *  C00026,C00038,C00107,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(429).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FMSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(429).NE.'n') then
      CALL S00075(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(429),
     *  C00026,C00044,C00108,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(433).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(433).NE.'n') then
      CALL S00076(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(433),
     *  C00044,C00102,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(110,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RETURN
15000 CALL PERET('M00003')
      RETURN
      END
      SUBROUTINE S00077(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00001=1,SSZ(18)
      RS1=RS1+C00102(SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(17)-
     *  1+I00001))),I00004,I00002)
    3 CONTINUE
      C00103(5,I00004,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00077')
      RETURN
      END
      SUBROUTINE S00078(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      C00102(SSMP(SSMPST(18)-1+1),I00004,I00002)=C00103(5,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00078')
      RETURN
      END
      SUBROUTINE S00079(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00109,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00109(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_NCOAL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(18)
      RS1=RS1+1
    1 CONTINUE
      C00109(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_NCOAL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00079')
      RETURN
      END
      SUBROUTINE S00080(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00103,C00109,C00110,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      REAL C00109(1)
      REAL C00110(SSZ(18),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHNCOAL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(18)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00103(5,I00004,I00002).EQ.0
      IF(.NOT.LG1) GOTO     3
      RS1=1.0
      RS2=C00109(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00110(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHNCOAL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00080')
      RETURN
      END
      SUBROUTINE S00081(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,C00110,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      REAL C00110(SSZ(18),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHNCOAL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(18)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00103(5,I00004,I00002).GT.0
      IF(.NOT.LG1) GOTO     3
      RS1=C00102(SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(17)-1+
     *  I00001))),I00004,I00002)
      RS2=C00103(5,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00110(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHNCOAL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00081')
      RETURN
      END
      SUBROUTINE S00082(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00001=1,SSZ(20)
      RS1=RS1+C00102(SSMP(SSMPST(19)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00103(4,I00004,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00082')
      RETURN
      END
      SUBROUTINE S00083(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      C00102(SSMP(SSMPST(20)-1+1),I00004,I00002)=C00103(4,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00083')
      RETURN
      END
      SUBROUTINE S00084(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00112,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00112(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_FUEL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(20)
      RS1=RS1+1
    1 CONTINUE
      C00112(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_FUEL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00084')
      RETURN
      END
      SUBROUTINE S00085(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00103,C00112,C00113,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      REAL C00112(1)
      REAL C00113(SSZ(20),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHNELY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(20)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00103(4,I00004,I00002).EQ.0
      IF(.NOT.LG1) GOTO     3
      RS1=1.0
      RS2=C00112(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00113(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHNELY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00085')
      RETURN
      END
      SUBROUTINE S00086(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,C00113,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      REAL C00113(SSZ(20),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHNELY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(20)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00103(4,I00004,I00002).GT.0
      IF(.NOT.LG1) GOTO     3
      RS1=C00102(SSMP(SSMPST(19)-1+I00001),I00004,I00002)
      RS2=C00103(4,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00113(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHNELY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00086')
      RETURN
      END
      SUBROUTINE S00087(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00115,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00115(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_ENY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(22)
      RS1=RS1+1
    1 CONTINUE
      C00115(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_ENY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00087')
      RETURN
      END
      SUBROUTINE S00088(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00001=1,SSZ(22)
      RS1=RS1+C00102(SSMP(SSMPST(21)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00103(3,I00004,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00088')
      RETURN
      END
      SUBROUTINE S00089(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      C00102(SSMP(SSMPST(22)-1+1),I00004,I00002)=C00103(3,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00089')
      RETURN
      END
      SUBROUTINE S00090(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00103,C00115,C00116,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      REAL C00115(1)
      REAL C00116(SSZ(22),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHENY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(22)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00103(3,I00004,I00002).EQ.0
      IF(.NOT.LG1) GOTO     3
      RS1=1.0
      RS2=C00115(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00116(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHENY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00090')
      RETURN
      END
      SUBROUTINE S00091(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,C00116,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      REAL C00116(SSZ(22),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHENY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(22)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00103(3,I00004,I00002).GT.0
      IF(.NOT.LG1) GOTO     3
      RS1=C00102(SSMP(SSMPST(21)-1+I00001),I00004,I00002)
      RS2=C00103(3,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00116(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHENY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00091')
      RETURN
      END
      SUBROUTINE S00092(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00001=1,SSZ(24)
      RS1=RS1+C00102(SSMP(SSMPST(23)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00103(2,I00004,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00092')
      RETURN
      END
      SUBROUTINE S00093(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      C00102(SSMP(SSMPST(24)-1+1),I00004,I00002)=C00103(2,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00093')
      RETURN
      END
      SUBROUTINE S00094(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00118,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00118(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_KEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(24)
      RS1=RS1+1
    1 CONTINUE
      C00118(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_KEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00094')
      RETURN
      END
      SUBROUTINE S00095(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00103,C00118,C00119,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      REAL C00118(1)
      REAL C00119(SSZ(24),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHKEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(24)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00103(2,I00004,I00002).EQ.0
      IF(.NOT.LG1) GOTO     3
      RS1=1.0
      RS2=C00118(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00119(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHKEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00095')
      RETURN
      END
      SUBROUTINE S00096(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,C00119,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      REAL C00119(SSZ(24),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHKEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(24)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00103(2,I00004,I00002).GT.0
      IF(.NOT.LG1) GOTO     3
      RS1=C00102(SSMP(SSMPST(23)-1+I00001),I00004,I00002)
      RS2=C00103(2,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00119(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHKEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00096')
      RETURN
      END
      SUBROUTINE S00097(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00001=1,SSZ(26)
      RS1=RS1+C00102(SSMP(SSMPST(25)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00103(1,I00004,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00097')
      RETURN
      END
      SUBROUTINE S00098(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      C00102(SSMP(SSMPST(26)-1+1),I00004,I00002)=C00103(1,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00098')
      RETURN
      END
      SUBROUTINE S00099(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00121,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00121(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_VAEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(26)
      RS1=RS1+1
    1 CONTINUE
      C00121(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_VAEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00099')
      RETURN
      END
      SUBROUTINE S00100(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00103,C00121,C00122,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      REAL C00121(1)
      REAL C00122(SSZ(26),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHVAEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(26)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00103(1,I00004,I00002).EQ.0
      IF(.NOT.LG1) GOTO     3
      RS1=1.0
      RS2=C00121(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00122(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHVAEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00100')
      RETURN
      END
      SUBROUTINE S00101(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00103,C00122,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00103(SSZ(16),SSZ(7),SSZ(1))
      REAL C00122(SSZ(26),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHVAEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(26)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00103(1,I00004,I00002).GT.0
      IF(.NOT.LG1) GOTO     3
      RS1=C00102(SSMP(SSMPST(25)-1+I00001),I00004,I00002)
      RS2=C00103(1,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00122(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHVAEN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00101')
      RETURN
      END
      SUBROUTINE M00004(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=18
       SSNO=17
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,17,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(445).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(445).NE.'n') then
      CALL S00077(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(445),
     *  C00102,C00103,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=19
       SSNO=18
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,18,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(448).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(448).NE.'n') then
      CALL S00078(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(448),
     *  C00102,C00103,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(450).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_NCOAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(450).NE.'n') then
      CALL S00079(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(450),
     *  C00109,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(452).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHNCOAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(452).NE.'n') then
      CALL S00080(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(452),
     *  C00103,C00109,C00110,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(453).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHNCOAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(453).NE.'n') then
      CALL S00081(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(453),
     *  C00102,C00103,C00110,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(113,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=20
       SSNO=19
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,19,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(460).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(460).NE.'n') then
      CALL S00082(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(460),
     *  C00102,C00103,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=21
       SSNO=20
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,20,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(463).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(463).NE.'n') then
      CALL S00083(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(463),
     *  C00102,C00103,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(465).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_FUEL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(465).NE.'n') then
      CALL S00084(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(465),
     *  C00112,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(467).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHNELY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(467).NE.'n') then
      CALL S00085(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(467),
     *  C00103,C00112,C00113,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(468).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHNELY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(468).NE.'n') then
      CALL S00086(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(468),
     *  C00102,C00103,C00113,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(116,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=22
       SSNO=21
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,21,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(476).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_ENY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(476).NE.'n') then
      CALL S00087(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(476),
     *  C00115,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(477).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(477).NE.'n') then
      CALL S00088(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(477),
     *  C00102,C00103,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=23
       SSNO=22
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,22,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(480).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(480).NE.'n') then
      CALL S00089(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(480),
     *  C00102,C00103,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(482).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHENY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(482).NE.'n') then
      CALL S00090(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(482),
     *  C00103,C00115,C00116,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(483).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHENY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(483).NE.'n') then
      CALL S00091(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(483),
     *  C00102,C00103,C00116,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(119,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=24
       SSNO=23
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,23,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(490).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(490).NE.'n') then
      CALL S00092(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(490),
     *  C00102,C00103,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=25
       SSNO=24
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,24,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(493).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(493).NE.'n') then
      CALL S00093(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(493),
     *  C00102,C00103,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(495).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_KEN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(495).NE.'n') then
      CALL S00094(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(495),
     *  C00118,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(497).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHKEN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(497).NE.'n') then
      CALL S00095(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(497),
     *  C00103,C00118,C00119,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(498).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHKEN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(498).NE.'n') then
      CALL S00096(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(498),
     *  C00102,C00103,C00119,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(122,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=26
       SSNO=25
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,25,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(505).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(505).NE.'n') then
      CALL S00097(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(505),
     *  C00102,C00103,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=27
       SSNO=26
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,26,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(508).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(508).NE.'n') then
      CALL S00098(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(508),
     *  C00102,C00103,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(510).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_VAEN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(510).NE.'n') then
      CALL S00099(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(510),
     *  C00121,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(512).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHVAEN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(512).NE.'n') then
      CALL S00100(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(512),
     *  C00103,C00121,C00122,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(513).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHVAEN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(513).NE.'n') then
      CALL S00101(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(513),
     *  C00102,C00103,C00122,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(127,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RETURN
15000 CALL PERET('M00004')
      RETURN
      END
      SUBROUTINE M00005(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=28
       SSNO=27
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,27,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00005')
      RETURN
      END
      SUBROUTINE S00102(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00125,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00125(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFATOT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00001=1,SSZ(28)
      RS1=RS1+C00102(SSMP(SSMPST(27)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00125(I00004,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VFATOT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00102')
      RETURN
      END
      SUBROUTINE S00103(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00126,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00126(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_TOP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00001=1,SSZ(28)
      RS1=RS1+1
    1 CONTINUE
      C00126(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SIZE_TOP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00103')
      RETURN
      END
      SUBROUTINE S00104(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00125,C00126,C00127,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00125(SSZ(7),SSZ(1))
      REAL C00126(1)
      REAL C00127(SSZ(28),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHTOP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(28)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00125(I00004,I00002).EQ.0.0
      IF(.NOT.LG1) GOTO     3
      RS1=1.0
      RS2=C00126(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00127(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHTOP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00104')
      RETURN
      END
      SUBROUTINE S00105(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00125,C00127,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00125(SSZ(7),SSZ(1))
      REAL C00127(SSZ(28),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CSHTOP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(28)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      LG1=C00125(I00004,I00002).GT.0.0
      IF(.NOT.LG1) GOTO     3
      RS1=C00102(SSMP(SSMPST(27)-1+I00001),I00004,I00002)
      RS2=C00125(I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00127(I00001,I00004,I00002)=RS3
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CSHTOP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00105')
      RETURN
      END
      SUBROUTINE S00106(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00077,C00078,C00128,C00129,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00077(SSZ(1))
      REAL C00078(SSZ(1))
      REAL C00128(SSZ(1))
      REAL C00129(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INVKERATIO"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00077(I00002)
      RS2=C00128(I00002)+C00078(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00129(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "INVKERATIO"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00106')
      RETURN
      END
      SUBROUTINE S00107(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00031,C00045,C00130,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00007
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00130(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GRNETRATIO"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00007=1,SSZ(12)
      RS1=RS1+C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00007))),I00002)
    2 CONTINUE
      RS2=0.0
      DO 3 I00007=1,SSZ(12)
      RS2=RS2+C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00007))),I00002)
    3 CONTINUE
      RS3=RS1
      RS4=RS2-C00031(I00002)
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE
        RS5=1.0
        IER=2
      END IF
      C00130(I00002)=RS5
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GRNETRATIO"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00107')
      RETURN
      END
      SUBROUTINE S00108(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00032,C00133,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00133(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "MSHRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 4 I00008=1,SSZ(1)
      RS1=RS1+C00032(I00001,I00008,I00003)
    4 CONTINUE
      RS2=C00032(I00001,I00002,I00003)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      C00133(I00001,I00002,I00003)=RS4
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "MSHRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00108')
      RETURN
      END
      SUBROUTINE S00109(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00136,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00136(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTFSD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 4 I00005=1,SSZ(3)
      RS1=RS1+C00135(I00005,I00001,I00002,I00003)
    4 CONTINUE
      C00136(I00001,I00002,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTFSD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00109')
      RETURN
      END
      SUBROUTINE S00110(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00137,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00137(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMUSE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00002=1,SSZ(1)
      RS3=0.0
      DO 2 I00001=1,SSZ(2)
      RS3=RS3+C00135(I00005,I00001,I00002,I00003)
    2 CONTINUE
      RS2=RS2+RS3
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00137(I00005)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTMUSE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00110')
      RETURN
      END
      SUBROUTINE S00111(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00036,C00138,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00138(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMPROV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00036(I00005,I00002)
    2 CONTINUE
      C00138(I00005)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTMPROV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00111')
      RETURN
      END
      SUBROUTINE S00112(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00036,C00139,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00139(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTRPROV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00005=1,SSZ(3)
      RS1=RS1+C00036(I00005,I00002)
    2 CONTINUE
      C00139(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTRPROV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00112')
      RETURN
      END
      SUBROUTINE S00113(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00036,C00140,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00140(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS2=0.0
      DO 1 I00005=1,SSZ(3)
      RS2=RS2+C00036(I00005,I00002)
    1 CONTINUE
      RS1=RS1+RS2
    2 CONTINUE
      C00140(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00113')
      RETURN
      END
      SUBROUTINE S00114(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00136,C00140,C00141,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00136(SSZ(2),SSZ(1),SSZ(1))
      REAL C00140(1)
      REAL C00141(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMUSESHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00003=1,SSZ(1)
      DO 3 I00002=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      DO 1 I00005=1,SSZ(3)
      RS1=C00136(I00001,I00002,I00003)
      RS2=C00140(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00141(I00005,I00001,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTMUSESHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00114')
      RETURN
      END
      SUBROUTINE S00115(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00137,C00141,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00137(SSZ(3))
      REAL C00141(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMUSESHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00005=1,SSZ(3)
      LG1=C00137(I00005).NE.0.0
      IF(.NOT.LG1) GOTO     1
      DO 2 I00001=1,SSZ(2)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      RS1=C00135(I00005,I00001,I00002,I00003)
      RS2=C00137(I00005)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00141(I00005,I00001,I00002,I00003)=RS3
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTMUSESHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00115')
      RETURN
      END
      SUBROUTINE S00116(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00139,C00140,C00142,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00139(SSZ(1))
      REAL C00140(1)
      REAL C00142(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTSUPPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=C00139(I00002)
      RS2=C00140(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00142(I00005,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTSUPPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00116')
      RETURN
      END
      SUBROUTINE S00117(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00036,C00138,C00142,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00138(SSZ(3))
      REAL C00142(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTSUPPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00005=1,SSZ(3)
      LG1=C00138(I00005).NE.0.0
      IF(.NOT.LG1) GOTO     1
      DO 2 I00002=1,SSZ(1)
      RS1=C00036(I00005,I00002)
      RS2=C00138(I00005)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00142(I00005,I00002)=RS3
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTSUPPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00117')
      RETURN
      END
      SUBROUTINE S00118(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00143,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00143(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTUSE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00002=1,SSZ(1)
      RS3=0.0
      DO 2 I00001=1,SSZ(2)
      RS4=0.0
      DO 1 I00005=1,SSZ(3)
      RS4=RS4+C00135(I00005,I00001,I00002,I00003)
    1 CONTINUE
      RS3=RS3+RS4
    2 CONTINUE
      RS2=RS2+RS3
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00143(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTUSE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00118')
      RETURN
      END
      SUBROUTINE S00119(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00136,C00144,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00136(SSZ(2),SSZ(1),SSZ(1))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTFSD_MSH"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00005=1,SSZ(3)
      DO 2 I00001=1,SSZ(2)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      LG1=C00136(I00001,I00002,I00003).GT.0.0
      IF(.NOT.LG1) GOTO     4
      RS1=C00135(I00005,I00001,I00002,I00003)
      RS2=C00136(I00001,I00002,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00144(I00005,I00001,I00002,I00003)=RS3
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTFSD_MSH"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00119')
      RETURN
      END
      SUBROUTINE S00120(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00136,C00137,C00143,C00144,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00136(SSZ(2),SSZ(1),SSZ(1))
      REAL C00137(SSZ(3))
      REAL C00143(1)
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTFSD_MSH"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00005=1,SSZ(3)
      DO 2 I00001=1,SSZ(2)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      LG1=C00136(I00001,I00002,I00003).EQ.0.0
      IF(.NOT.LG1) GOTO     4
      RS1=C00137(I00005)
      RS2=C00143(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00144(I00005,I00001,I00002,I00003)=RS3
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTFSD_MSH"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00120')
      RETURN
      END
      SUBROUTINE S00121(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00136,C00145,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00136(SSZ(2),SSZ(1),SSZ(1))
      REAL C00145(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWSCOST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00145(I00001,I00002,I00003)=C00034(I00001,I00002,I00003)+
     *  C00136(I00001,I00002,I00003)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWSCOST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00121')
      RETURN
      END
      SUBROUTINE S00122(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00145,C00146,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00145(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FOBSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00034(I00001,I00002,I00003)
      RS2=C00145(I00001,I00002,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00146(I00001,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FOBSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00122')
      RETURN
      END
      SUBROUTINE S00123(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00136,C00145,C00147,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00136(SSZ(2),SSZ(1),SSZ(1))
      REAL C00145(SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TRNSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00136(I00001,I00002,I00003)
      RS2=C00145(I00001,I00002,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00147(I00001,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TRNSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00123')
      RETURN
      END
      SUBROUTINE S00124(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00008,C00148,C00149,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00006
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00148(SSZ(1))
      REAL C00149(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2QB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00006=1,SSZ(15)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      LG1=C00008(I00002).EQ.I00006
      IF(.NOT.LG1) GOTO     2
      RS1=RS1+C00148(I00002)
    2 CONTINUE
      C00149(I00006)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CO2QB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00124')
      RETURN
      END
      SUBROUTINE S00125(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00051,C00052,C00150,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00051(SSZ(1))
      REAL C00052(SSZ(1))
      REAL C00150(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00051(I00002)
      RS2=C00052(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00150(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00125')
      RETURN
      END
      SUBROUTINE S00126(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00052,C00151,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00049(SSZ(1))
      REAL C00052(SSZ(1))
      REAL C00151(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00049(I00002)
      RS2=C00052(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00151(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00126')
      RETURN
      END
      SUBROUTINE S00127(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00009,C00052,C00152,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00052(SSZ(1))
      REAL C00152(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00009(I00002)
      RS2=C00052(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00152(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00127')
      RETURN
      END
      SUBROUTINE S00128(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00070,C00154,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00154(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(6)
      RS1=RS1+C00070(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE
      C00154(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00128')
      RETURN
      END
      SUBROUTINE S00129(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00028,C00155,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00028(SSZ(6),SSZ(7),SSZ(1))
      REAL C00155(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "REVSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(6)
      RS1=0.0
      DO 4 I00008=1,SSZ(7)
      RS1=RS1+C00028(I00001,I00008,I00002)
    4 CONTINUE
      RS2=C00028(I00001,I00004,I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      C00155(I00001,I00004,I00002)=RS4
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "REVSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00129')
      RETURN
      END
      SUBROUTINE S00130(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00157,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00157(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PIND"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00157(I00002)=1.0
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PIND"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00130')
      RETURN
      END
      SUBROUTINE S00131(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00008,C00052,C00158,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00006
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00052(SSZ(1))
      REAL C00158(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INCOMEB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00006=1,SSZ(15)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      LG1=C00008(I00002).EQ.I00006
      IF(.NOT.LG1) GOTO     2
      RS1=RS1+C00052(I00002)
    2 CONTINUE
      C00158(I00006)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "INCOMEB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00131')
      RETURN
      END
      SUBROUTINE S00132(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00159,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00006
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00159(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PINDB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00006=1,SSZ(15)
      C00159(I00006)=1.0
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PINDB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00132')
      RETURN
      END
      SUBROUTINE S00133(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00008,C00043,C00084,C00085,C00160,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00006
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL LG1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00043(SSZ(1))
      REAL C00084(SSZ(1))
      REAL C00085(SSZ(15))
      REAL C00160(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "NCTAXLEVB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00006=1,SSZ(15)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      LG1=C00008(I00002).EQ.I00006
      IF(.NOT.LG1) GOTO     2
      RS1=RS1+C00043(I00002)*C00084(I00002)
    2 CONTINUE
      RS2=RS1
      RS3=C00085(I00006)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      C00160(I00006)=RS4
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "NCTAXLEVB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00133')
      RETURN
      END
      SUBROUTINE S00134(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00083,C00161,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00083(SSZ(1),SSZ(2))
      REAL C00161(SSZ(1),SSZ(14))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2_L"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00001=1,SSZ(14)
      DO 1 I00002=1,SSZ(1)
      C00161(I00002,I00001)=C00083(I00002,SSMP(SSMPST(13)-1+
     *  SSMP(SSMPST(14)-1+I00001)))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CO2_L"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00134')
      RETURN
      END
      SUBROUTINE S00135(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00043,C00162,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00162(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "NOMCTAX_L"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00162(I00002)=C00043(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "NOMCTAX_L"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00135')
      RETURN
      END
      SUBROUTINE S00136(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00153,C00161,C00162,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00153(SSZ(1),SSZ(14))
      REAL C00161(SSZ(1),SSZ(14))
      REAL C00162(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00001=1,SSZ(14)
      DO 1 I00002=1,SSZ(1)
      C00153(I00002,I00001)=C00161(I00002,I00001)*C00162(I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00136')
      RETURN
      END
      SUBROUTINE S00137(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00031,C00047,C00163,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00163(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(6)
      RS1=RS1+C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE
      C00163(I00002)=RS1-C00031(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00137')
      RETURN
      END
      SUBROUTINE S00138(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00057,C00062,C00067,C00069,C00071,C00073,C00075,C00164,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00057(SSZ(1))
      REAL C00062(SSZ(1))
      REAL C00067(SSZ(1))
      REAL C00069(SSZ(1))
      REAL C00071(SSZ(1))
      REAL C00073(SSZ(1))
      REAL C00075(SSZ(1))
      REAL C00164(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INDTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00164(I00002)=C00062(I00002)+C00067(I00002)+C00057(I00002)+
     *  C00069(I00002)+C00071(I00002)+C00073(I00002)+C00075(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "INDTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00138')
      RETURN
      END
      SUBROUTINE M00006(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(529).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFATOT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(529).NE.'n') then
      CALL S00102(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(529),
     *  C00102,C00125,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(531).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_TOP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(531).NE.'n') then
      CALL S00103(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(531),
     *  C00126,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(533).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHTOP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(533).NE.'n') then
      CALL S00104(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(533),
     *  C00125,C00126,C00127,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(534).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CSHTOP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(534).NE.'n') then
      CALL S00105(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(534),
     *  C00102,C00125,C00127,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(554).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INVKERATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(554).NE.'n') then
      CALL S00106(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(554),
     *  C00077,C00078,C00128,C00129,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(557).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GRNETRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(557).NE.'n') then
      CALL S00107(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(557),
     *  C00031,C00045,C00130,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(581).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'MSHRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(581).NE.'n') then
      CALL S00108(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(581),
     *  C00032,C00133,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(603).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(603).NE.'n') then
      CALL S00109(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(603),
     *  C00135,C00136,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(605).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(605).NE.'n') then
      CALL S00110(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(605),
     *  C00135,C00137,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(607).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMPROV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(607).NE.'n') then
      CALL S00111(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(607),
     *  C00036,C00138,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(609).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTRPROV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(609).NE.'n') then
      CALL S00112(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(609),
     *  C00036,C00139,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(611).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(611).NE.'n') then
      CALL S00113(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(611),
     *  C00036,C00140,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(614).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSESHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(614).NE.'n') then
      CALL S00114(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(614),
     *  C00136,C00140,C00141,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(615).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSESHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(615).NE.'n') then
      CALL S00115(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(615),
     *  C00135,C00137,C00141,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(618).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTSUPPSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(618).NE.'n') then
      CALL S00116(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(618),
     *  C00139,C00140,C00142,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(619).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTSUPPSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(619).NE.'n') then
      CALL S00117(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(619),
     *  C00036,C00138,C00142,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(622).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTUSE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(622).NE.'n') then
      CALL S00118(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(622),
     *  C00135,C00143,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(624).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD_MSH',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(624).NE.'n') then
      CALL S00119(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(624),
     *  C00135,C00136,C00144,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(625).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD_MSH',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(625).NE.'n') then
      CALL S00120(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(625),
     *  C00136,C00137,C00143,C00144,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(630).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWSCOST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(630).NE.'n') then
      CALL S00121(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(630),
     *  C00034,C00136,C00145,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(632).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FOBSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(632).NE.'n') then
      CALL S00122(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(632),
     *  C00034,C00145,C00146,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(634).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TRNSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(634).NE.'n') then
      CALL S00123(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(634),
     *  C00136,C00145,C00147,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(647).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2QB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(647).NE.'n') then
      CALL S00124(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(647),
     *  C00008,C00148,C00149,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(652).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRPRIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(652).NE.'n') then
      CALL S00125(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(652),
     *  C00051,C00052,C00150,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(654).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRGOV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(654).NE.'n') then
      CALL S00126(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(654),
     *  C00049,C00052,C00151,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(656).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRSAVE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(656).NE.'n') then
      CALL S00127(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(656),
     *  C00009,C00052,C00152,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(666).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TINC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(666).NE.'n') then
      CALL S00128(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(666),
     *  C00070,C00154,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(669).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'REVSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(669).NE.'n') then
      CALL S00129(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(669),
     *  C00028,C00155,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(687).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PIND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(687).NE.'n') then
      CALL S00130(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(687),
     *  C00157,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(692).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INCOMEB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(692).NE.'n') then
      CALL S00131(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(692),
     *  C00008,C00052,C00158,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(697).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PINDB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(697).NE.'n') then
      CALL S00132(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(697),
     *  C00159,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(700).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NCTAXLEVB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(700).NE.'n') then
      CALL S00133(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(700),
     *  C00008,C00043,C00084,C00085,C00160,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(706).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2_L',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(706).NE.'n') then
      CALL S00134(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(706),
     *  C00083,C00161,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(709).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NOMCTAX_L',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(709).NE.'n') then
      CALL S00135(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(709),
     *  C00043,C00162,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(712).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VCTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(712).NE.'n') then
      CALL S00136(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(712),
     *  C00153,C00161,C00162,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(716).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(716).NE.'n') then
      CALL S00137(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(716),
     *  C00031,C00047,C00163,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(725).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INDTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(725).NE.'n') then
      CALL S00138(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(725),
     *  C00057,C00062,C00067,C00069,C00071,C00073,C00075,C00164,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00006')
      RETURN
      END
      SUBROUTINE S00139(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00082,C00150,C00151,C00152,C00165,C00166,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00082(SSZ(1))
      REAL C00150(SSZ(1))
      REAL C00151(SSZ(1))
      REAL C00152(SSZ(1))
      REAL C00165(SSZ(1))
      REAL C00166(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILELAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00082(I00002)*C00150(I00002)+C00151(I00002)+C00152(I00002)
      RS2=C00165(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00166(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILELAS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00139')
      RETURN
      END
      SUBROUTINE S00140(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00082,C00150,C00166,C00167,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00082(SSZ(1))
      REAL C00150(SSZ(1))
      REAL C00166(SSZ(1))
      REAL C00167(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPARPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00082(I00002)*C00150(I00002)
      RS2=C00166(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00167(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DPARPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00140')
      RETURN
      END
      SUBROUTINE S00141(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00151,C00166,C00168,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00151(SSZ(1))
      REAL C00166(SSZ(1))
      REAL C00168(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPARGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00151(I00002)
      RS2=C00166(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00168(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DPARGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00141')
      RETURN
      END
      SUBROUTINE S00142(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00152,C00166,C00169,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00152(SSZ(1))
      REAL C00166(SSZ(1))
      REAL C00169(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPARSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00152(I00002)
      RS2=C00166(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00169(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "DPARSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00142')
      RETURN
      END
      SUBROUTINE S00143(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00170,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00170(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00170(I00002)=1.0
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00143')
      RETURN
      END
      SUBROUTINE S00144(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00171,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00171(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00171(I00002)=1.0
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00144')
      RETURN
      END
      SUBROUTINE S00145(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00172,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00172(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00172(I00002)=1.0
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00145')
      RETURN
      END
      SUBROUTINE S00146(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00030,C00046,C00173,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00030(SSZ(2),SSZ(7),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00173(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      RS1=C00030(I00001,I00004,I00002)
      RS2=C00046(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00173(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRDFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00146')
      RETURN
      END
      SUBROUTINE S00147(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00018,C00046,C00174,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00018(SSZ(2),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00018(I00001,I00002)
      RS2=C00046(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00174(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRDPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00147')
      RETURN
      END
      SUBROUTINE S00148(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00012,C00046,C00175,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00012(SSZ(2),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00175(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00012(I00001,I00002)
      RS2=C00046(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00175(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRDGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00148')
      RETURN
      END
      SUBROUTINE S00149(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00046,C00047,C00176,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00176(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00046(I00001,I00002)
      RS2=C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00176(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRDM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00149')
      RETURN
      END
      SUBROUTINE S00150(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00036,C00047,C00177,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00177(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=C00036(I00005,I00002)
      RS2=C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005))),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00177(I00005,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00150')
      RETURN
      END
      SUBROUTINE S00151(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00035,C00047,C00178,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00178(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRXMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00035(I00001,I00002,I00003)
      RS2=C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00178(I00001,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRXMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00151')
      RETURN
      END
      SUBROUTINE S00152(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00015,C00021,C00029,C00179,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00015(SSZ(2),SSZ(1))
      REAL C00021(SSZ(2),SSZ(1))
      REAL C00029(SSZ(2),SSZ(7),SSZ(1))
      REAL C00179(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00029(I00001,I00004,I00002)
    3 CONTINUE
      C00179(I00001,I00002)=RS1+C00021(I00001,I00002)+
     *  C00015(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00152')
      RETURN
      END
      SUBROUTINE S00153(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00029,C00179,C00180,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00029(SSZ(2),SSZ(7),SSZ(1))
      REAL C00179(SSZ(2),SSZ(1))
      REAL C00180(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRIFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      RS1=C00029(I00001,I00004,I00002)
      RS2=C00179(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00180(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRIFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00153')
      RETURN
      END
      SUBROUTINE S00154(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00179,C00181,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00021(SSZ(2),SSZ(1))
      REAL C00179(SSZ(2),SSZ(1))
      REAL C00181(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRIPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00021(I00001,I00002)
      RS2=C00179(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00181(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRIPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00154')
      RETURN
      END
      SUBROUTINE S00155(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00015,C00179,C00182,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00015(SSZ(2),SSZ(1))
      REAL C00179(SSZ(2),SSZ(1))
      REAL C00182(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRIGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00015(I00001,I00002)
      RS2=C00179(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00182(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHRIGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00155')
      RETURN
      END
      SUBROUTINE S00156(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00028,C00047,C00183,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00028(SSZ(6),SSZ(7),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00183(SSZ(11),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHREM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(11)
      RS1=C00028(SSMP(SSMPST(11)-1+I00001),I00004,I00002)
      RS2=C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001))),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00183(I00001,I00004,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SHREM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00156')
      RETURN
      END
      SUBROUTINE S00157(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00036,C00184,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00184(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00184(SSMP(SSMPST(1)-1+I00005),I00002)=RS1+C00036(I00005,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VXW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00157')
      RETURN
      END
      SUBROUTINE S00158(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00184,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00184(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00184(SSMP(SSMPST(2)-1+I00001),I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VXW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00158')
      RETURN
      END
      SUBROUTINE S00159(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00184,C00185,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00184(SSZ(2),SSZ(1))
      REAL C00185(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXWREGION"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00184(I00001,I00002)
    2 CONTINUE
      C00185(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VXWREGION"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00159')
      RETURN
      END
      SUBROUTINE S00160(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00186,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00186(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS1=RS1+C00033(I00001,I00002,I00003)
    3 CONTINUE
      C00186(I00001,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00160')
      RETURN
      END
      SUBROUTINE S00161(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00186,C00187,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00186(SSZ(2),SSZ(1))
      REAL C00187(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWREGION"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00186(I00001,I00002)
    2 CONTINUE
      C00187(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWREGION"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00161')
      RETURN
      END
      SUBROUTINE S00162(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00047,C00188,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00188(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VENDWREG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(6)
      RS1=RS1+C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE
      C00188(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VENDWREG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00162')
      RETURN
      END
      SUBROUTINE S00163(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00188,C00189,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00188(SSZ(1))
      REAL C00189(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VENDWWLD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00002=1,SSZ(1)
      RS1=RS1+C00188(I00002)
    1 CONTINUE
      C00189(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VENDWWLD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00163')
      RETURN
      END
      SUBROUTINE S00164(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00034,C00036,C00045,C00048,C00050,C00190,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00190(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GDP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00003=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00050(I00001,I00003)
    2 CONTINUE
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00048(I00001,I00003)
    3 CONTINUE
      RS3=0.0
      DO 4 I00008=1,SSZ(5)
      RS3=RS3+C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00008)),I00003)
    4 CONTINUE
      RS4=0.0
      DO 6 I00002=1,SSZ(1)
      RS5=0.0
      DO 5 I00001=1,SSZ(2)
      RS5=RS5+C00034(I00001,I00003,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    6 CONTINUE
      RS6=0.0
      DO 7 I00005=1,SSZ(3)
      RS6=RS6+C00036(I00005,I00003)
    7 CONTINUE
      RS7=0.0
      DO 9 I00002=1,SSZ(1)
      RS8=0.0
      DO 8 I00001=1,SSZ(2)
      RS8=RS8+C00033(I00001,I00002,I00003)
    8 CONTINUE
      RS7=RS7+RS8
    9 CONTINUE
      C00190(I00003)=RS1+RS2+RS3+RS4+RS6-RS7
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GDP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00164')
      RETURN
      END
      SUBROUTINE S00165(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00184,C00191,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00184(SSZ(2),SSZ(1))
      REAL C00191(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXWCOMMOD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00184(I00001,I00002)
    2 CONTINUE
      C00191(I00001)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VXWCOMMOD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00165')
      RETURN
      END
      SUBROUTINE S00166(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00185,C00192,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00185(SSZ(1))
      REAL C00192(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXWLD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      RS1=0.0
      DO 1 I00002=1,SSZ(1)
      RS1=RS1+C00185(I00002)
    1 CONTINUE
      C00192(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VXWLD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00166')
      RETURN
      END
      SUBROUTINE S00167(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00186,C00193,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00186(SSZ(2),SSZ(1))
      REAL C00193(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWCOMMOD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00186(I00001,I00002)
    2 CONTINUE
      C00193(I00001)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWCOMMOD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00167')
      RETURN
      END
      SUBROUTINE S00168(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00035,C00194,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00194(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PW_PM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(I00001,I00002,I00003)
    3 CONTINUE
      RS2=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=RS2+C00035(I00001,I00002,I00003)
    4 CONTINUE
      RS3=RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE
        RS5=1.0
        IER=2
      END IF
      C00194(I00001,I00002)=RS5
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PW_PM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00168')
      RETURN
      END
      SUBROUTINE S00169(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00036,C00046,C00194,C00195,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00194(SSZ(2),SSZ(1))
      REAL C00195(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00195(SSMP(SSMPST(1)-1+I00005),I00002)=C00046(SSMP(SSMPST(1)-1+
     *  I00005),I00002)*C00194(SSMP(SSMPST(1)-1+I00005),I00002)+RS1+
     *  C00036(I00005,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00169')
      RETURN
      END
      SUBROUTINE S00170(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00046,C00194,C00195,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00194(SSZ(2),SSZ(1))
      REAL C00195(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00195(SSMP(SSMPST(2)-1+I00001),I00002)=C00046(SSMP(SSMPST(2)-1+
     *  I00001),I00002)*C00194(SSMP(SSMPST(2)-1+I00001),I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00170')
      RETURN
      END
      SUBROUTINE S00171(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00195,C00196,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00195(SSZ(2),SSZ(1))
      REAL C00196(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VWOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00195(I00001,I00002)
    2 CONTINUE
      C00196(I00001)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VWOW"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00171')
      RETURN
      END
      SUBROUTINE S00172(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00044,C00048,C00050,C00197,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00197(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VWOU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 2 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00004=1,SSZ(7)
      RS2=RS2+C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)
    3 CONTINUE
      RS1=RS1+C00050(I00001,I00003)+C00048(I00001,I00003)+RS2
    2 CONTINUE
      C00197(I00001)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VWOU"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00172')
      RETURN
      END
      SUBROUTINE S00173(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00185,C00187,C00198,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00185(SSZ(1))
      REAL C00187(SSZ(1))
      REAL C00198(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TBAL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00198(I00002)=C00185(I00002)-C00187(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TBAL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00173')
      RETURN
      END
      SUBROUTINE S00174(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00010,C00013,C00016,C00019,C00024,C00026,C00199,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00199(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TOTDEM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(13)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00024(SSMP(SSMPST(13)-1+I00001),I00004,I00002)
    3 CONTINUE
      RS2=0.0
      DO 4 I00004=1,SSZ(7)
      RS2=RS2+C00026(SSMP(SSMPST(13)-1+I00001),I00004,I00002)
    4 CONTINUE
      C00199(I00001,I00002)=RS1+RS2+C00016(SSMP(SSMPST(13)-1+
     *  I00001),I00002)+C00019(SSMP(SSMPST(13)-1+I00001),I00002)+
     *  C00010(SSMP(SSMPST(13)-1+I00001),I00002)+C00013(SSMP(SSMPST(13)-
     *  1+I00001),I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "TOTDEM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00174')
      RETURN
      END
      SUBROUTINE S00175(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00052,C00200,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      REAL C00200(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INCOMEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00200(I00002)=C00052(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "INCOMEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00175')
      RETURN
      END
      SUBROUTINE S00176(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00170,C00201,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00170(SSZ(1))
      REAL C00201(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00201(I00002)=C00170(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00176')
      RETURN
      END
      SUBROUTINE S00177(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00171,C00202,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00171(SSZ(1))
      REAL C00202(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00202(I00002)=C00171(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00177')
      RETURN
      END
      SUBROUTINE S00178(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00172,C00203,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00172(SSZ(1))
      REAL C00203(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00203(I00002)=C00172(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00178')
      RETURN
      END
      SUBROUTINE S00179(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00204,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00204(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      C00204(I00001,I00002)=C00050(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VPAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00179')
      RETURN
      END
      SUBROUTINE M00007(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(740).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILELAS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(740).NE.'n') then
      CALL S00139(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(740),
     *  C00082,C00150,C00151,C00152,C00165,C00166,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(742).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPARPRIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(742).NE.'n') then
      CALL S00140(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(742),
     *  C00082,C00150,C00166,C00167,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(744).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPARGOV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(744).NE.'n') then
      CALL S00141(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(744),
     *  C00151,C00166,C00168,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(746).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPARSAVE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(746).NE.'n') then
      CALL S00142(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(746),
     *  C00152,C00166,C00169,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(748).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILPRIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(748).NE.'n') then
      CALL S00143(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(748),
     *  C00170,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(752).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILGOV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(752).NE.'n') then
      CALL S00144(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(752),
     *  C00171,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(756).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILSAVE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(756).NE.'n') then
      CALL S00145(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(756),
     *  C00172,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(763).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(763).NE.'n') then
      CALL S00146(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(763),
     *  C00030,C00046,C00173,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(765).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(765).NE.'n') then
      CALL S00147(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(765),
     *  C00018,C00046,C00174,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(767).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDGM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(767).NE.'n') then
      CALL S00148(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(767),
     *  C00012,C00046,C00175,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(771).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(771).NE.'n') then
      CALL S00149(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(771),
     *  C00046,C00047,C00176,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(773).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(773).NE.'n') then
      CALL S00150(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(773),
     *  C00036,C00047,C00177,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(775).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRXMD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(775).NE.'n') then
      CALL S00151(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(775),
     *  C00035,C00047,C00178,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(780).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(780).NE.'n') then
      CALL S00152(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(780),
     *  C00015,C00021,C00029,C00179,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(782).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(782).NE.'n') then
      CALL S00153(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(782),
     *  C00029,C00179,C00180,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(784).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(784).NE.'n') then
      CALL S00154(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(784),
     *  C00021,C00179,C00181,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(786).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIGM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(786).NE.'n') then
      CALL S00155(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(786),
     *  C00015,C00179,C00182,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(789).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHREM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(789).NE.'n') then
      CALL S00156(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(789),
     *  C00028,C00047,C00183,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(803).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(803).NE.'n') then
      CALL S00157(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(803),
     *  C00034,C00036,C00184,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(804).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(804).NE.'n') then
      CALL S00158(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(804),
     *  C00034,C00184,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(806).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWREGION',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(806).NE.'n') then
      CALL S00159(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(806),
     *  C00184,C00185,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(808).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(808).NE.'n') then
      CALL S00160(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(808),
     *  C00033,C00186,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(810).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWREGION',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(810).NE.'n') then
      CALL S00161(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(810),
     *  C00186,C00187,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(814).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VENDWREG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(814).NE.'n') then
      CALL S00162(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(814),
     *  C00047,C00188,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(818).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VENDWWLD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(818).NE.'n') then
      CALL S00163(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(818),
     *  C00188,C00189,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(828).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GDP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(828).NE.'n') then
      CALL S00164(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(828),
     *  C00033,C00034,C00036,C00045,C00048,C00050,C00190,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(839).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWCOMMOD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(839).NE.'n') then
      CALL S00165(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(839),
     *  C00184,C00191,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(841).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWLD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(841).NE.'n') then
      CALL S00166(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(841),
     *  C00185,C00192,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(843).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWCOMMOD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(843).NE.'n') then
      CALL S00167(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(843),
     *  C00186,C00193,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(845).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PW_PM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(845).NE.'n') then
      CALL S00168(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(845),
     *  C00034,C00035,C00194,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(847).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(847).NE.'n') then
      CALL S00169(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(847),
     *  C00034,C00036,C00046,C00194,C00195,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(848).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(848).NE.'n') then
      CALL S00170(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(848),
     *  C00034,C00046,C00194,C00195,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(850).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VWOW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(850).NE.'n') then
      CALL S00171(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(850),
     *  C00195,C00196,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(852).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VWOU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(852).NE.'n') then
      CALL S00172(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(852),
     *  C00044,C00048,C00050,C00197,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(912).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TBAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(912).NE.'n') then
      CALL S00173(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(912),
     *  C00185,C00187,C00198,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(916).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TOTDEM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(916).NE.'n') then
      CALL S00174(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(916),
     *  C00010,C00013,C00016,C00019,C00024,C00026,C00199,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(932).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INCOMEEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(932).NE.'n') then
      CALL S00175(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(932),
     *  C00052,C00200,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(936).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILPRIVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(936).NE.'n') then
      CALL S00176(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(936),
     *  C00170,C00201,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(940).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILGOVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(940).NE.'n') then
      CALL S00177(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(940),
     *  C00171,C00202,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(944).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILSAVEEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(944).NE.'n') then
      CALL S00178(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(944),
     *  C00172,C00203,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(950).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(950).NE.'n') then
      CALL S00179(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(950),
     *  C00050,C00204,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00007')
      RETURN
      END
      SUBROUTINE S00180(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00204,C00205,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00204(SSZ(2),SSZ(1))
      REAL C00205(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPAREGEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00204(I00001,I00002)
    2 CONTINUE
      C00205(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VPAREGEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00180')
      RETURN
      END
      SUBROUTINE S00181(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00204,C00205,C00206,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00204(SSZ(2),SSZ(1))
      REAL C00205(SSZ(1))
      REAL C00206(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CONSHREV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00204(I00001,I00002)
      RS2=C00205(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00206(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "CONSHREV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00181')
      RETURN
      END
      SUBROUTINE S00182(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00081,C00093,C00206,C00207,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00009
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00093(SSZ(2),SSZ(1))
      REAL C00206(SSZ(2),SSZ(1))
      REAL C00207(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EYEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00009=1,SSZ(2)
      RS1=RS1+C00206(I00009,I00002)*C00081(I00009,I00002)
    3 CONTINUE
      RS2=1.0
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS5=0.0
      DO 4 I00009=1,SSZ(2)
      RS5=RS5+C00206(I00009,I00002)*C00081(I00009,I00002)*
     *  C00093(I00009,I00002)
    4 CONTINUE
      RS6=0.0
      DO 5 I00009=1,SSZ(2)
      RS6=RS6+C00206(I00009,I00002)*C00093(I00009,I00002)
    5 CONTINUE
      C00207(I00001,I00002)=RS4*(C00081(I00001,I00002)*(1.0-
     *  C00093(I00001,I00002))+RS5)+C00093(I00001,I00002)-RS6
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "EYEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00182')
      RETURN
      END
      SUBROUTINE S00183(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00081,C00206,C00208,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00206(SSZ(2),SSZ(1))
      REAL C00208(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UELASPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00206(I00001,I00002)*C00081(I00001,I00002)
    2 CONTINUE
      C00208(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UELASPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00183')
      RETURN
      END
      SUBROUTINE S00184(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00081,C00206,C00208,C00209,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00081(SSZ(2),SSZ(1))
      REAL C00206(SSZ(2),SSZ(1))
      REAL C00208(SSZ(1))
      REAL C00209(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XWCONSHREV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00206(I00001,I00002)*C00081(I00001,I00002)
      RS2=C00208(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00209(I00001,I00002)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XWCONSHREV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00184')
      RETURN
      END
      SUBROUTINE S00185(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00051,C00210,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00051(SSZ(1))
      REAL C00210(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PRIVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00210(I00002)=C00051(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "PRIVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00185')
      RETURN
      END
      SUBROUTINE S00186(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00049,C00211,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00049(SSZ(1))
      REAL C00211(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GOVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00211(I00002)=C00049(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "GOVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00186')
      RETURN
      END
      SUBROUTINE S00187(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00009,C00212,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00212(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00212(I00002)=C00009(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00187')
      RETURN
      END
      SUBROUTINE S00188(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00200,C00210,C00213,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00200(SSZ(1))
      REAL C00210(SSZ(1))
      REAL C00213(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00210(I00002)
      RS2=C00200(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00213(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00188')
      RETURN
      END
      SUBROUTINE S00189(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00200,C00211,C00214,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00200(SSZ(1))
      REAL C00211(SSZ(1))
      REAL C00214(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00211(I00002)
      RS2=C00200(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00214(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00189')
      RETURN
      END
      SUBROUTINE S00190(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00200,C00212,C00215,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00200(SSZ(1))
      REAL C00212(SSZ(1))
      REAL C00215(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00212(I00002)
      RS2=C00200(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00215(I00002)=RS3
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "XSHRSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00190')
      RETURN
      END
      SUBROUTINE S00191(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00166,C00216,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00166(SSZ(1))
      REAL C00216(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILELASEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00216(I00002)=C00166(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "UTILELASEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00191')
      RETURN
      END
      SUBROUTINE S00192(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00052,C00166,C00200,C00216,C00217,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      REAL C00166(SSZ(1))
      REAL C00200(SSZ(1))
      REAL C00216(SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EVSCALFACT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)
      RS1=C00216(I00002)
      RS2=C00166(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=C00200(I00002)
      RS5=C00052(I00002)
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IER=2
      END IF
      C00217(I00002)=RS3*RS6
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "EVSCALFACT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00192')
      RETURN
      END
      SUBROUTINE S00193(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00218,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00218(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00135(I00005,I00001,I00002,I00003)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00218(I00005,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00193')
      RETURN
      END
      SUBROUTINE S00194(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00036,C00219,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      INTEGER I00010
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00219(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE
      RS2=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=0.0
      DO 4 I00008=1,SSZ(2)
      RS3=RS3+C00034(I00008,I00002,I00003)
    4 CONTINUE
      RS2=RS2+RS3
    5 CONTINUE
      RS4=0.0
      DO 6 I00010=1,SSZ(3)
      RS4=RS4+C00036(I00010,I00002)
    6 CONTINUE
      RS5=RS1+C00036(I00005,I00002)
      RS6=RS2+RS4
      IF(RS6.NE.0.0) THEN
        RS7=RS5/RS6
      ELSE
        RS7=1.0
        IER=2
      END IF
      C00219(SSMP(SSMPST(1)-1+I00005),I00002)=RS7
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SX_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00194')
      RETURN
      END
      SUBROUTINE S00195(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00036,C00219,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      INTEGER I00010
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00219(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      RS2=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=0.0
      DO 4 I00008=1,SSZ(2)
      RS3=RS3+C00034(I00008,I00002,I00003)
    4 CONTINUE
      RS2=RS2+RS3
    5 CONTINUE
      RS4=0.0
      DO 6 I00010=1,SSZ(3)
      RS4=RS4+C00036(I00010,I00002)
    6 CONTINUE
      RS5=RS1
      RS6=RS2+RS4
      IF(RS6.NE.0.0) THEN
        RS7=RS5/RS6
      ELSE
        RS7=1.0
        IER=2
      END IF
      C00219(SSMP(SSMPST(2)-1+I00001),I00002)=RS7
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SX_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00195')
      RETURN
      END
      SUBROUTINE S00196(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00220,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00220(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTICOMM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00135(I00005,I00001,I00002,I00003)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00220(I00005,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VTICOMM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00196')
      RETURN
      END
      SUBROUTINE S00197(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00220,C00221,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00220(SSZ(3),SSZ(1))
      REAL C00221(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWDIRALL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00221(SSMP(SSMPST(1)-1+I00005),I00003)=RS1+C00220(I00005,I00003)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWDIRALL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00197')
      RETURN
      END
      SUBROUTINE S00198(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00221,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00221(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWDIRALL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00221(SSMP(SSMPST(2)-1+I00001),I00003)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWDIRALL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00198')
      RETURN
      END
      SUBROUTINE S00199(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00221,C00222,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00221(SSZ(2),SSZ(1))
      REAL C00222(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWDATOT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00003=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00221(I00001,I00003)
    2 CONTINUE
      C00222(I00003)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "VIWDATOT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00199')
      RETURN
      END
      SUBROUTINE S00200(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00221,C00222,C00223,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00221(SSZ(2),SSZ(1))
      REAL C00222(SSZ(1))
      REAL C00223(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SM_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00221(I00001,I00003)
      RS2=C00222(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00223(I00001,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SM_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00200')
      RETURN
      END
      SUBROUTINE S00201(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00036,C00224,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00224(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00005=1,SSZ(3)
      DO 2 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00008)
    3 CONTINUE
      DO 4 I00003=1,SSZ(1)
      RS2=C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      RS3=RS1+C00036(I00005,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      C00224(SSMP(SSMPST(1)-1+I00005),I00002,I00003)=RS4
    4 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SX_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00201')
      RETURN
      END
      SUBROUTINE S00202(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00224,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00224(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(4)
      DO 2 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00008)
    3 CONTINUE
      DO 4 I00003=1,SSZ(1)
      RS2=C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IER=4
      END IF
      C00224(SSMP(SSMPST(2)-1+I00001),I00002,I00003)=RS4
    4 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SX_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00202')
      RETURN
      END
      SUBROUTINE S00203(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00036,C00225,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00225(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SXT_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00008)
    3 CONTINUE
      RS2=C00036(I00005,I00002)
      RS3=RS1+C00036(I00005,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      C00225(I00005,I00002)=RS4
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SXT_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00203')
      RETURN
      END
      SUBROUTINE S00204(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00221,C00226,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00221(SSZ(2),SSZ(1))
      REAL C00226(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SM_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=C00034(I00001,I00002,I00003)
      RS2=C00221(I00001,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00226(I00001,I00002,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SM_IRS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00204')
      RETURN
      END
      SUBROUTINE S00205(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00220,C00221,C00227,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00220(SSZ(3),SSZ(1))
      REAL C00221(SSZ(2),SSZ(1))
      REAL C00227(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SMT_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=C00220(I00005,I00003)
      RS2=C00221(SSMP(SSMPST(1)-1+I00005),I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00227(I00005,I00003)=RS3
    1 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SMT_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00205')
      RETURN
      END
      SUBROUTINE S00206(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00036,C00228,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00228(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 2 I00008=1,SSZ(1)
      RS2=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=RS2+C00034(SSMP(SSMPST(1)-1+I00005),I00008,I00003)
    3 CONTINUE
      RS1=RS1+RS2+C00036(I00005,I00008)
    2 CONTINUE
      DO 4 I00002=1,SSZ(1)
      RS3=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=RS3+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    5 CONTINUE
      RS4=RS3+C00036(I00005,I00002)
      RS5=RS1
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IER=2
      END IF
      C00228(SSMP(SSMPST(1)-1+I00005),I00002)=RS6
    4 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SW_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00206')
      RETURN
      END
      SUBROUTINE S00207(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00228,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00228(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 2 I00008=1,SSZ(1)
      RS2=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=RS2+C00034(SSMP(SSMPST(2)-1+I00001),I00008,I00003)
    3 CONTINUE
      RS1=RS1+RS2
    2 CONTINUE
      DO 4 I00002=1,SSZ(1)
      RS3=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=RS3+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    5 CONTINUE
      RS4=RS3
      RS5=RS1
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IER=2
      END IF
      C00228(SSMP(SSMPST(2)-1+I00001),I00002)=RS6
    4 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SW_IR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00207')
      RETURN
      END
      SUBROUTINE S00208(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00036,C00229,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      INTEGER I00010
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00229(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_I"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      RS1=0.0
      DO 1 I00008=1,SSZ(2)
      RS2=0.0
      DO 2 I00002=1,SSZ(1)
      RS3=0.0
      DO 3 I00003=1,SSZ(1)
      RS3=RS3+C00034(I00008,I00002,I00003)
    3 CONTINUE
      RS2=RS2+RS3
    2 CONTINUE
      RS1=RS1+RS2
    1 CONTINUE
      RS4=0.0
      DO 4 I00010=1,SSZ(3)
      RS5=0.0
      DO 5 I00002=1,SSZ(1)
      RS5=RS5+C00036(I00010,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    4 CONTINUE
      DO 6 I00005=1,SSZ(3)
      RS6=0.0
      DO 7 I00002=1,SSZ(1)
      RS7=0.0
      DO 8 I00003=1,SSZ(1)
      RS7=RS7+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    8 CONTINUE
      RS6=RS6+RS7+C00036(I00005,I00002)
    7 CONTINUE
      RS8=RS6
      RS9=RS1+RS4
      IF(RS9.NE.0.0) THEN
        RS10=RS8/RS9
      ELSE
        RS10=1.0
        IER=2
      END IF
      C00229(SSMP(SSMPST(1)-1+I00005))=RS10
    6 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SW_I"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00208')
      RETURN
      END
      SUBROUTINE S00209(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00036,C00229,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      INTEGER I00010
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00229(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_I"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      RS1=0.0
      DO 1 I00008=1,SSZ(2)
      RS2=0.0
      DO 2 I00002=1,SSZ(1)
      RS3=0.0
      DO 3 I00003=1,SSZ(1)
      RS3=RS3+C00034(I00008,I00002,I00003)
    3 CONTINUE
      RS2=RS2+RS3
    2 CONTINUE
      RS1=RS1+RS2
    1 CONTINUE
      RS4=0.0
      DO 4 I00010=1,SSZ(3)
      RS5=0.0
      DO 5 I00002=1,SSZ(1)
      RS5=RS5+C00036(I00010,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    4 CONTINUE
      DO 6 I00001=1,SSZ(4)
      RS6=0.0
      DO 7 I00002=1,SSZ(1)
      RS7=0.0
      DO 8 I00003=1,SSZ(1)
      RS7=RS7+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    8 CONTINUE
      RS6=RS6+RS7
    7 CONTINUE
      RS8=RS6
      RS9=RS1+RS4
      IF(RS9.NE.0.0) THEN
        RS10=RS8/RS9
      ELSE
        RS10=1.0
        IER=2
      END IF
      C00229(SSMP(SSMPST(2)-1+I00001))=RS10
    6 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       CALL TBEDZ(NZDZ,ZDZVAL,NNDZ,NDZVAL,'fm',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "SW_I"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00209')
      RETURN
      END
      SUBROUTINE S00210(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00230,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00230(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00230"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00048(I00001,I00002)
    2 CONTINUE
      C00230(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00230"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00210')
      RETURN
      END
      SUBROUTINE M00008(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(ECHO1.AND.DOIG(954).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPAREGEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(954).NE.'n') then
      CALL S00180(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(954),
     *  C00204,C00205,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(956).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CONSHREV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(956).NE.'n') then
      CALL S00181(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(956),
     *  C00204,C00205,C00206,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(958).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EYEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(958).NE.'n') then
      CALL S00182(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(958),
     *  C00081,C00093,C00206,C00207,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(961).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UELASPRIVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(961).NE.'n') then
      CALL S00183(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(961),
     *  C00081,C00206,C00208,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(964).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XWCONSHREV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(964).NE.'n') then
      CALL S00184(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(964),
     *  C00081,C00206,C00208,C00209,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(968).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PRIVEXPEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(968).NE.'n') then
      CALL S00185(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(968),
     *  C00051,C00210,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(972).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GOVEXPEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(972).NE.'n') then
      CALL S00186(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(972),
     *  C00049,C00211,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(976).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SAVEEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(976).NE.'n') then
      CALL S00187(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(976),
     *  C00009,C00212,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(980).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRPRIVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(980).NE.'n') then
      CALL S00188(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(980),
     *  C00200,C00210,C00213,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(982).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRGOVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(982).NE.'n') then
      CALL S00189(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(982),
     *  C00200,C00211,C00214,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(984).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRSAVEEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(984).NE.'n') then
      CALL S00190(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(984),
     *  C00200,C00212,C00215,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(993).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILELASEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(993).NE.'n') then
      CALL S00191(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(993),
     *  C00166,C00216,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1002).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EVSCALFACT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1002).NE.'n') then
      CALL S00192(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1002),
     *  C00052,C00166,C00200,C00216,C00217,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1004).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1004).NE.'n') then
      CALL S00193(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1004),
     *  C00135,C00218,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1095).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1095).NE.'n') then
      CALL S00194(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1095),
     *  C00034,C00036,C00219,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1096).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1096).NE.'n') then
      CALL S00195(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1096),
     *  C00034,C00036,C00219,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1098).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTICOMM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1098).NE.'n') then
      CALL S00196(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1098),
     *  C00135,C00220,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1100).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDIRALL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1100).NE.'n') then
      CALL S00197(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1100),
     *  C00034,C00220,C00221,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1101).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDIRALL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1101).NE.'n') then
      CALL S00198(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1101),
     *  C00034,C00221,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1103).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDATOT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1103).NE.'n') then
      CALL S00199(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1103),
     *  C00221,C00222,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1105).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SM_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1105).NE.'n') then
      CALL S00200(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1105),
     *  C00221,C00222,C00223,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=0
      END IF
      IF(ECHO1.AND.DOIG(1108).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1108).NE.'n') then
      CALL S00201(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1108),
     *  C00034,C00036,C00224,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1109).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1109).NE.'n') then
      CALL S00202(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1109),
     *  C00034,C00224,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1112).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SXT_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1112).NE.'n') then
      CALL S00203(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1112),
     *  C00034,C00036,C00225,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1117).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SM_IRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1117).NE.'n') then
      CALL S00204(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1117),
     *  C00034,C00221,C00226,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1119).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SMT_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1119).NE.'n') then
      CALL S00205(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1119),
     *  C00220,C00221,C00227,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1124).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1124).NE.'n') then
      CALL S00206(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1124),
     *  C00034,C00036,C00228,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1125).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1125).NE.'n') then
      CALL S00207(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1125),
     *  C00034,C00228,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1129).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_I',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1129).NE.'n') then
      CALL S00208(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1129),
     *  C00034,C00036,C00229,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1130).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_I',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1130).NE.'n') then
      CALL S00209(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1130),
     *  C00034,C00036,C00229,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00010),C00010,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00011),C00011,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00012),C00012,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00013),C00013,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00014),C00014,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00015),C00015,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00016),C00016,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00017),C00017,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00018),C00018,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00019),C00019,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00020),C00020,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00021),C00021,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00022),C00022,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00023),C00023,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00024),C00024,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00025),C00025,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00026),C00026,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00027),C00027,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00028),C00028,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00029),C00029,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00030),C00030,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00031),C00031,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00032),C00032,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00033),C00033,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00034),C00034,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00035),C00035,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00036),C00036,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00037),C00037,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00038),C00038,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00039),C00039,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00040),C00040,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00041),C00041,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00042),C00042,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00128),C00128,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00135),C00135,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00148),C00148,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(1151).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00230',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1151).NE.'n') then
      CALL S00210(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1151),
     *  C00048,C00230,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00008')
      RETURN
      END
      SUBROUTINE S00211(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00231,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00231(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00231"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=C00048(I00011,I00002)*C00048(I00001,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4
    3 CONTINUE
      C00231(I00001,I00002)=-C00048(I00001,I00002)*(-1.0+1.0)-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00231"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00211')
      RETURN
      END
      SUBROUTINE S00212(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00232,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00232(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00232"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=C00048(I00011,I00002)*C00048(I00001,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4
    3 CONTINUE
      C00232(I00001,I00002)=C00048(I00001,I00002)-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00232"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00212')
      RETURN
      END
      SUBROUTINE S00213(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00087,C00089,C00090,C00233,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00233(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00233"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=C00048(I00001,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(-C00090(I00001,I00002)*100.0 *C00089(I00001,I00002)-
     *  (1  -C00090(I00001,I00002))*100.0 *C00087(I00001,I00002))
    2 CONTINUE
      C00233(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00233"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00213')
      RETURN
      END
      SUBROUTINE S00214(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00076,C00087,C00089,C00090,C00234,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00234(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00234"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=C00048(I00011,I00003)
      RS3=C00049(I00003)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(-C00090(I00011,I00003)*100.0 *C00089(I00011,I00003)-
     *  (1  -C00090(I00011,I00003))*100.0 *C00087(I00011,I00003))
    3 CONTINUE
      C00234(I00001,I00003)=C00076(I00001)*100.0 *C00089(I00001,I00003)+
     *  (-1.0+C00076(I00001))*(-C00090(I00001,I00003)*100.0 *
     *  C00089(I00001,I00003)-(1  -C00090(I00001,I00003))*100.0 *
     *  C00087(I00001,I00003))+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00234"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00214')
      RETURN
      END
      SUBROUTINE S00215(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00076,C00087,C00089,C00090,C00235,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00235(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00235"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=C00048(I00011,I00003)
      RS3=C00049(I00003)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(-C00090(I00011,I00003)*100.0 *C00089(I00011,I00003)-
     *  (1  -C00090(I00011,I00003))*100.0 *C00087(I00011,I00003))
    3 CONTINUE
      C00235(I00001,I00003)=C00076(I00001)*100.0 *C00087(I00001,I00003)+
     *  (-1.0+C00076(I00001))*(-C00090(I00001,I00003)*100.0 *
     *  C00089(I00001,I00003)-(1  -C00090(I00001,I00003))*100.0 *
     *  C00087(I00001,I00003))+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00235"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00215')
      RETURN
      END
      SUBROUTINE S00216(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00087,C00089,C00090,C00151,C00236,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00151(SSZ(1))
      REAL C00236(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00236"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=C00151(I00002)*C00048(I00001,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(-C00090(I00001,I00002)*100.0 *C00089(I00001,I00002)-
     *  (1  -C00090(I00001,I00002))*100.0 *C00087(I00001,I00002))
    2 CONTINUE
      C00236(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00236"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00216')
      RETURN
      END
      SUBROUTINE S00217(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00087,C00089,C00090,C00231,C00237,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00231(SSZ(2),SSZ(1))
      REAL C00237(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00237"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00231(I00001,I00002)*(-C00090(I00001,I00002)*100.0 *
     *  C00089(I00001,I00002)-(1  -C00090(I00001,I00002))*100.0 *
     *  C00087(I00001,I00002))
    2 CONTINUE
      C00237(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00237"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00217')
      RETURN
      END
      SUBROUTINE S00218(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00087,C00089,C00090,C00238,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00238(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00238"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00048(I00001,I00002)*(-C00090(I00001,I00002)*100.0 *
     *  C00089(I00001,I00002)-(1  -C00090(I00001,I00002))*100.0 *
     *  C00087(I00001,I00002))
    2 CONTINUE
      C00238(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00238"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00218')
      RETURN
      END
      SUBROUTINE S00219(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00087,C00089,C00090,C00232,C00239,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00232(SSZ(2),SSZ(1))
      REAL C00239(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00239"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00232(I00001,I00002)*(-C00090(I00001,I00002)*100.0 *
     *  C00089(I00001,I00002)-(1  -C00090(I00001,I00002))*100.0 *
     *  C00087(I00001,I00002))
    2 CONTINUE
      C00239(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00239"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00219')
      RETURN
      END
      SUBROUTINE S00220(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00087,C00089,C00090,C00240,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00240(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00240"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=C00048(I00001,I00003)*C00048(I00011,I00003)
      RS3=C00049(I00003)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(-C00090(I00011,I00003)*100.0 *C00089(I00011,I00003)-
     *  (1  -C00090(I00011,I00003))*100.0 *C00087(I00011,I00003))
    3 CONTINUE
      C00240(I00001,I00003)=C00048(I00001,I00003)*(1.0-1.0)*(-
     *  C00090(I00001,I00003)*100.0 *C00089(I00001,I00003)-(1  -
     *  C00090(I00001,I00003))*100.0 *C00087(I00001,I00003))+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00240"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00220')
      RETURN
      END
      SUBROUTINE S00221(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00087,C00089,C00090,C00241,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00241(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00241"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=C00048(I00001,I00003)*C00048(I00011,I00003)
      RS3=C00049(I00003)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(-C00090(I00011,I00003)*100.0 *C00089(I00011,I00003)-
     *  (1  -C00090(I00011,I00003))*100.0 *C00087(I00011,I00003))
    3 CONTINUE
      C00241(I00001,I00003)=-C00048(I00001,I00003)*(-
     *  C00090(I00001,I00003)*100.0 *C00089(I00001,I00003)-(1  -
     *  C00090(I00001,I00003))*100.0 *C00087(I00001,I00003))+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00241"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00221')
      RETURN
      END
      SUBROUTINE S00222(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00063,C00065,C00076,C00086,C00090,C00242,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00242(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00242"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=C00065(I00011,I00002)*C00048(I00001,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(1  -C00090(I00001,I00002))*C00086(I00001,I00002)
    3 CONTINUE
      C00242(I00001,I00002)=-(C00063(I00001,I00002)+
     *  C00065(I00001,I00002)*(-1.0+C00076(I00001))*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002))-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00242"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00222')
      RETURN
      END
      SUBROUTINE S00223(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00065,C00076,C00088,C00090,C00243,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00243(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00243"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=C00065(I00011,I00002)*C00048(I00001,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*C00090(I00001,I00002)*C00088(I00001,I00002)
    3 CONTINUE
      C00243(I00001,I00002)=-C00065(I00001,I00002)*(1.0-(C00076(I00001)*
     *  C00088(I00001,I00002)-(-1.0+C00076(I00001))*
     *  C00090(I00001,I00002)*C00088(I00001,I00002)))-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00243"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00223')
      RETURN
      END
      SUBROUTINE S00224(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00065,C00234,C00244,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00234(SSZ(2),SSZ(1))
      REAL C00244(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00244"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00065(I00001,I00002)*C00234(I00001,I00002)
    2 CONTINUE
      C00244(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00244"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00224')
      RETURN
      END
      SUBROUTINE S00225(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00065,C00245,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00245(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00245"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00065(I00001,I00002)
    2 CONTINUE
      C00245(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00245"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00225')
      RETURN
      END
      SUBROUTINE S00226(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00065,C00066,C00076,C00086,C00090,C00217,
     *  C00246,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00246(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00246"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=(C00065(I00011,I00002)+C00066(I00011,I00002))*
     *  C00048(I00001,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(1  -C00090(I00001,I00002))*C00086(I00001,I00002)
    3 CONTINUE
      C00246(I00001,I00002)=-0.01  *C00217(I00002)*
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))*(-1.0+
     *  C00076(I00001))*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002)-0.01  *C00217(I00002)*RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00246"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00226')
      RETURN
      END
      SUBROUTINE S00227(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00065,C00066,C00076,C00088,C00090,C00217,
     *  C00247,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00247(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00247"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=(C00065(I00011,I00002)+C00066(I00011,I00002))*
     *  C00048(I00001,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*C00090(I00001,I00002)*C00088(I00001,I00002)
    3 CONTINUE
      C00247(I00001,I00002)=0.01  *C00217(I00002)*
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))*(C00076(I00001)*
     *  C00088(I00001,I00002)-(-1.0+C00076(I00001))*
     *  C00090(I00001,I00002)*C00088(I00001,I00002))-0.01  *
     *  C00217(I00002)*RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00247"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00227')
      RETURN
      END
      SUBROUTINE S00228(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00065,C00066,C00217,C00234,C00248,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00234(SSZ(2),SSZ(1))
      REAL C00248(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00248"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-(C00065(I00001,I00002)+C00066(I00001,I00002))*
     *  C00234(I00001,I00002)
    2 CONTINUE
      C00248(I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00248"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00228')
      RETURN
      END
      SUBROUTINE S00229(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00031,C00045,C00053,C00054,C00055,C00056,C00058,C00059,
     *  C00060,C00061,C00063,C00064,C00065,C00066,C00068,C00070,
     *  C00072,C00074,C00200,C00217,C00249,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15,RS16
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00200(SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00249(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00249"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(9)
      RS1=RS1-C00070(I00001,I00002)
    2 CONTINUE
      RS2=0.0
      DO 4 I00004=1,SSZ(7)
      RS3=0.0
      DO 3 I00001=1,SSZ(6)
      RS3=RS3-C00068(I00001,I00004,I00002)
    3 CONTINUE
      RS2=RS2+RS3
    4 CONTINUE
      RS4=0.0
      DO 5 I00004=1,SSZ(7)
      RS5=0.0
      DO 6 I00001=1,SSZ(2)
      RS5=RS5-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))
    6 CONTINUE
      RS4=RS4+RS5
    5 CONTINUE
      RS6=0.0
      DO 7 I00004=1,SSZ(7)
      RS7=0.0
      DO 8 I00001=1,SSZ(2)
      RS7=RS7-(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))
    8 CONTINUE
      RS6=RS6+RS7
    7 CONTINUE
      RS8=0.0
      DO 9 I00001=1,SSZ(2)
      RS8=RS8-(C00060(I00001,I00002)+C00061(I00001,I00002))
    9 CONTINUE
      RS9=0.0
      DO 10 I00001=1,SSZ(2)
      RS9=RS9-(C00058(I00001,I00002)+C00059(I00001,I00002))
   10 CONTINUE
      RS10=0.0
      DO 11 I00001=1,SSZ(2)
      RS10=RS10+(C00065(I00001,I00002)+C00066(I00001,I00002))*(1.0-1.0)
   11 CONTINUE
      RS11=0.0
      DO 12 I00001=1,SSZ(2)
      RS11=RS11-(C00063(I00001,I00002)+C00064(I00001,I00002))
   12 CONTINUE
      RS12=0.0
      DO 13 I00001=1,SSZ(2)
      RS13=0.0
      DO 14 I00003=1,SSZ(1)
      RS13=RS13-C00072(I00001,I00002,I00003)
   14 CONTINUE
      RS12=RS12+RS13
   13 CONTINUE
      RS14=0.0
      DO 15 I00001=1,SSZ(2)
      RS15=0.0
      DO 16 I00003=1,SSZ(1)
      RS15=RS15-C00074(I00001,I00003,I00002)
   16 CONTINUE
      RS14=RS14+RS15
   15 CONTINUE
      RS16=0.0
      DO 17 I00001=1,SSZ(6)
      RS16=RS16-C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00002)
   17 CONTINUE
      C00249(I00002)=-(0.01  *C00217(I00002)*(RS1+RS2+RS4+RS6+RS8+RS9+
     *  RS10+RS11+RS12+RS14+RS16+C00031(I00002))+0.01  *C00200(I00002))
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00249"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00229')
      RETURN
      END
      SUBROUTINE S00230(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00065,C00066,C00217,C00250,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00250(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00250"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00065(I00001,I00002)+C00066(I00001,I00002)
    2 CONTINUE
      C00250(I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00250"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00230')
      RETURN
      END
      SUBROUTINE S00231(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00065,C00066,C00076,C00086,C00090,C00217,
     *  C00251,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00251(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00251"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=(C00065(I00011,I00002)+C00066(I00011,I00002))*0.01  *
     *  C00217(I00002)*C00048(I00001,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(1  -C00090(I00001,I00002))*C00086(I00001,I00002)
    3 CONTINUE
      C00251(I00001,I00002)=-(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*0.01  *C00217(I00002)*(-1.0+
     *  C00076(I00001))*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002)-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00251"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00231')
      RETURN
      END
      SUBROUTINE S00232(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00049,C00065,C00066,C00076,C00088,C00090,C00217,
     *  C00252,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00252(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00252"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=(C00065(I00011,I00002)+C00066(I00011,I00002))*0.01  *
     *  C00217(I00002)*C00048(I00001,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*C00090(I00001,I00002)*C00088(I00001,I00002)
    3 CONTINUE
      C00252(I00001,I00002)=(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*0.01  *C00217(I00002)*(C00076(I00001)*
     *  C00088(I00001,I00002)-(-1.0+C00076(I00001))*
     *  C00090(I00001,I00002)*C00088(I00001,I00002))-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00252"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00232')
      RETURN
      END
      SUBROUTINE S00233(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00065,C00066,C00217,C00234,C00253,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00234(SSZ(2),SSZ(1))
      REAL C00253(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00253"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00234(I00001,I00002)
    2 CONTINUE
      C00253(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00253"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00233')
      RETURN
      END
      SUBROUTINE S00234(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00065,C00066,C00217,C00254,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00254(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00254"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00217(I00002)*(1.0-1.0)
    2 CONTINUE
      C00254(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00254"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00234')
      RETURN
      END
      SUBROUTINE S00235(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00065,C00066,C00217,C00255,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00255(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00255"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00217(I00002)
    2 CONTINUE
      C00255(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00255"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00235')
      RETURN
      END
      SUBROUTINE S00236(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00053,C00054,C00055,C00056,C00058,C00059,C00060,C00061,
     *  C00063,C00064,C00065,C00066,C00068,C00070,C00072,C00074,
     *  C00217,C00256,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00256(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00256"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(9)
      RS1=RS1-C00070(I00001,I00002)
    2 CONTINUE
      RS2=0.0
      DO 4 I00004=1,SSZ(7)
      RS3=0.0
      DO 3 I00001=1,SSZ(6)
      RS3=RS3-C00068(I00001,I00004,I00002)
    3 CONTINUE
      RS2=RS2+RS3
    4 CONTINUE
      RS4=0.0
      DO 5 I00004=1,SSZ(7)
      RS5=0.0
      DO 6 I00001=1,SSZ(2)
      RS5=RS5-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))
    6 CONTINUE
      RS4=RS4+RS5
    5 CONTINUE
      RS6=0.0
      DO 7 I00004=1,SSZ(7)
      RS7=0.0
      DO 8 I00001=1,SSZ(2)
      RS7=RS7-(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))
    8 CONTINUE
      RS6=RS6+RS7
    7 CONTINUE
      RS8=0.0
      DO 9 I00001=1,SSZ(2)
      RS8=RS8-(C00060(I00001,I00002)+C00061(I00001,I00002))
    9 CONTINUE
      RS9=0.0
      DO 10 I00001=1,SSZ(2)
      RS9=RS9-(C00058(I00001,I00002)+C00059(I00001,I00002))
   10 CONTINUE
      RS10=0.0
      DO 11 I00001=1,SSZ(2)
      RS10=RS10+(C00065(I00001,I00002)+C00066(I00001,I00002))*(1.0-1.0)
   11 CONTINUE
      RS11=0.0
      DO 12 I00001=1,SSZ(2)
      RS11=RS11-(C00063(I00001,I00002)+C00064(I00001,I00002))
   12 CONTINUE
      RS12=0.0
      DO 13 I00001=1,SSZ(2)
      RS13=0.0
      DO 14 I00003=1,SSZ(1)
      RS13=RS13-C00072(I00001,I00002,I00003)
   14 CONTINUE
      RS12=RS12+RS13
   13 CONTINUE
      RS14=0.0
      DO 15 I00001=1,SSZ(2)
      RS15=0.0
      DO 16 I00003=1,SSZ(1)
      RS15=RS15-C00074(I00001,I00003,I00002)
   16 CONTINUE
      RS14=RS14+RS15
   15 CONTINUE
      C00256(I00002)=-0.01  *C00217(I00002)*(RS1+RS2+RS4+RS6+RS8+RS9+
     *  RS10+RS11+RS12+RS14)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00256"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00236')
      RETURN
      END
      SUBROUTINE S00237(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00053,C00054,C00055,C00056,C00058,C00059,C00060,C00061,
     *  C00063,C00064,C00065,C00066,C00070,C00072,C00074,C00217,
     *  C00257,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00257(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00257"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))
    3 CONTINUE
      RS2=0.0
      DO 4 I00004=1,SSZ(7)
      RS2=RS2-(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))
    4 CONTINUE
      RS3=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=RS3-C00072(I00001,I00002,I00003)
    5 CONTINUE
      RS4=0.0
      DO 6 I00003=1,SSZ(1)
      RS4=RS4-C00074(I00001,I00003,I00002)
    6 CONTINUE
      C00257(I00001,I00002)=-0.01  *C00217(I00002)*(-
     *  C00070(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+RS1+
     *  RS2-(C00060(I00001,I00002)+C00061(I00001,I00002))-
     *  (C00058(I00001,I00002)+C00059(I00001,I00002))+
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))*(1.0-1.0)-
     *  (C00063(I00001,I00002)+C00064(I00001,I00002))+RS3+RS4)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00257"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00237')
      RETURN
      END
      SUBROUTINE S00238(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00091,C00095,C00258,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00091(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00258(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00258"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00091(I00001,I00002)*(-1.0+C00095(I00001,I00002))
    2 CONTINUE
      C00258(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00258"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00238')
      RETURN
      END
      SUBROUTINE S00239(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00091,C00095,C00259,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00091(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00259(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00259"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00091(I00001,I00002)*(C00095(I00001,I00002)-1.0)
    2 CONTINUE
      C00259(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00259"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00239')
      RETURN
      END
      SUBROUTINE S00240(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00091,C00096,C00260,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00091(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL C00260(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00260"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS1=RS1+C00091(I00011,I00002)*C00096(I00011,I00001,I00002)
    3 CONTINUE
      C00260(I00001,I00002)=-C00091(I00001,I00002)-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00260"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00240')
      RETURN
      END
      SUBROUTINE S00241(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00095,C00230,C00261,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00230(SSZ(1))
      REAL C00261(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00261"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00050(I00001,I00002)*(-1.0+C00095(I00001,I00002))
    2 CONTINUE
      C00261(I00002)=C00230(I00002)+RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00261"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00241')
      RETURN
      END
      SUBROUTINE S00242(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00095,C00262,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00262(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00262"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00050(I00001,I00002)*C00095(I00001,I00002)
    2 CONTINUE
      C00262(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00262"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00242')
      RETURN
      END
      SUBROUTINE S00243(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00096,C00263,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL C00263(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00263"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS1=RS1-C00050(I00011,I00002)*C00096(I00011,I00001,I00002)
    3 CONTINUE
      C00263(I00001,I00002)=-C00050(I00001,I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00263"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00243')
      RETURN
      END
      SUBROUTINE S00244(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00096,C00264,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL C00264(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00264"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00008=1,SSZ(2)
      RS1=0.0
      DO 3 I00001=1,SSZ(2)
      RS1=RS1-C00050(I00001,I00002)*C00096(I00001,I00008,I00002)
    3 CONTINUE
      C00264(I00008,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00264"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00244')
      RETURN
      END
      SUBROUTINE S00245(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00076,C00100,C00265,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00265(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00265"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00060(I00001,I00002)*C00076(I00001)*100.0 *
     *  C00100(I00001,I00002)
    2 CONTINUE
      C00265(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00265"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00245')
      RETURN
      END
      SUBROUTINE S00246(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00095,C00266,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00266(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00266"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00060(I00001,I00002)*(-1.0+C00095(I00001,I00002))
    2 CONTINUE
      C00266(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00266"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00246')
      RETURN
      END
      SUBROUTINE S00247(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00095,C00267,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00267(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00267"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00060(I00001,I00002)*C00095(I00001,I00002)
    2 CONTINUE
      C00267(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00267"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00247')
      RETURN
      END
      SUBROUTINE S00248(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00076,C00096,C00268,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL C00268(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00268"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00008=1,SSZ(2)
      RS1=0.0
      DO 3 I00001=1,SSZ(2)
      RS1=RS1+C00060(I00001,I00002)*C00096(I00001,I00008,I00002)
    3 CONTINUE
      C00268(I00008,I00002)=-RS1-C00060(I00008,I00002)*C00076(I00008)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00268"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00248')
      RETURN
      END
      SUBROUTINE S00249(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00061,C00076,C00100,C00217,C00248,C00269,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00248(SSZ(1))
      REAL C00269(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00269"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*100.0 *
     *  C00100(I00001,I00002)
    2 CONTINUE
      C00269(I00002)=RS1+C00248(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00269"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00249')
      RETURN
      END
      SUBROUTINE S00250(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00061,C00095,C00217,C00249,C00270,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00249(SSZ(1))
      REAL C00270(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00270"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*(-1.0+C00095(I00001,I00002))
    2 CONTINUE
      C00270(I00002)=RS1+C00249(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00270"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00250')
      RETURN
      END
      SUBROUTINE S00251(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00061,C00095,C00217,C00271,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00271(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00271"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00095(I00001,I00002)
    2 CONTINUE
      C00271(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00271"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00251')
      RETURN
      END
      SUBROUTINE S00252(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00061,C00076,C00096,C00217,C00272,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00272(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00272"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00008=1,SSZ(2)
      RS1=0.0
      DO 3 I00001=1,SSZ(2)
      RS1=RS1-0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00096(I00001,I00008,I00002)
    3 CONTINUE
      C00272(I00008,I00002)=RS1-0.01  *C00217(I00002)*
     *  (C00060(I00008,I00002)+C00061(I00008,I00002))*C00076(I00008)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00272"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00252')
      RETURN
      END
      SUBROUTINE S00253(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00061,C00076,C00100,C00217,C00273,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00273(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00273"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00076(I00001)*100.0 *C00100(I00001,I00002)
    2 CONTINUE
      C00273(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00273"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00253')
      RETURN
      END
      SUBROUTINE S00254(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00061,C00095,C00217,C00274,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00274(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00274"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00217(I00002)*(-(-1.0+C00095(I00001,I00002))-1.0)
    2 CONTINUE
      C00274(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00274"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00254')
      RETURN
      END
      SUBROUTINE S00255(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00061,C00095,C00217,C00275,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00275(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00275"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00095(I00001,I00002)
    2 CONTINUE
      C00275(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00275"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00255')
      RETURN
      END
      SUBROUTINE S00256(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00061,C00076,C00096,C00217,C00276,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00276(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00276"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00008=1,SSZ(2)
      RS1=0.0
      DO 3 I00001=1,SSZ(2)
      RS1=RS1+(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00096(I00001,I00008,I00002)
    3 CONTINUE
      C00276(I00008,I00002)=-RS1-(C00060(I00008,I00002)+
     *  C00061(I00008,I00002))*0.01  *C00217(I00002)*C00076(I00008)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00276"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00256')
      RETURN
      END
      SUBROUTINE S00257(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00060,C00061,C00095,C00217,C00256,C00277,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00256(SSZ(1))
      REAL C00277(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00277"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*(-1.0+C00095(I00001,I00002))
    2 CONTINUE
      C00277(I00002)=RS1+C00256(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00277"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00257')
      RETURN
      END
      SUBROUTINE S00258(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00010,C00013,C00016,C00024,C00076,C00086,C00090,C00097,
     *  C00104,C00278,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00097(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(7),SSZ(1))
      REAL C00278(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00278"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(13)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-C00024(SSMP(SSMPST(13)-1+I00001),I00004,I00002)*
     *  C00104(SSMP(SSMPST(13)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00278(I00001,I00002)=-C00010(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00086(SSMP(SSMPST(13)-1+I00001),I00002)-C00013(SSMP(SSMPST(13)-
     *  1+I00001),I00002)*(-1.0+C00076(SSMP(SSMPST(13)-1+I00001)))*(1  -
     *  C00090(SSMP(SSMPST(13)-1+I00001),I00002))*
     *  C00086(SSMP(SSMPST(13)-1+I00001),I00002)-C00016(SSMP(SSMPST(13)-
     *  1+I00001),I00002)*C00097(SSMP(SSMPST(13)-1+I00001),I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00278"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00258')
      RETURN
      END
      SUBROUTINE S00259(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00010,C00013,C00016,C00019,C00024,C00076,C00087,C00089,
     *  C00098,C00100,C00105,C00234,C00279,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00098(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00105(SSZ(2),SSZ(7),SSZ(1))
      REAL C00234(SSZ(2),SSZ(1))
      REAL C00279(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00279"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(13)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-C00024(SSMP(SSMPST(13)-1+I00001),I00004,I00002)*100.0 *
     *  C00105(SSMP(SSMPST(13)-1+I00001),I00004,I00002)
    3 CONTINUE
      RS2=RS1+C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))*100.0 *C00100(SSMP(SSMPST(13)-
     *  1+I00001),I00002)-C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  100.0 *C00100(SSMP(SSMPST(13)-1+I00001),I00002)-
     *  C00016(SSMP(SSMPST(13)-1+I00001),I00002)*100.0 *
     *  C00098(SSMP(SSMPST(13)-1+I00001),I00002)+C00013(SSMP(SSMPST(13)-
     *  1+I00001),I00002)*C00234(SSMP(SSMPST(13)-1+I00001),I00002)
      C00279(I00001,I00002)=RS2-C00013(SSMP(SSMPST(13)-1+
     *  I00001),I00002)*100.0 *C00089(SSMP(SSMPST(13)-1+I00001),I00002)-
     *  C00010(SSMP(SSMPST(13)-1+I00001),I00002)*100.0 *
     *  C00087(SSMP(SSMPST(13)-1+I00001),I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00279"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00259')
      RETURN
      END
      SUBROUTINE S00260(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00013,C00019,C00026,C00076,C00088,C00090,C00099,C00106,
     *  C00280,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00280(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00280"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(13)
      RS1=C00013(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  (C00076(SSMP(SSMPST(13)-1+I00001))*C00088(SSMP(SSMPST(13)-1+
     *  I00001),I00002)-(-1.0+C00076(SSMP(SSMPST(13)-1+I00001)))*
     *  C00090(SSMP(SSMPST(13)-1+I00001),I00002)*C00088(SSMP(SSMPST(13)-
     *  1+I00001),I00002))-C00013(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00088(SSMP(SSMPST(13)-1+I00001),I00002)-C00019(SSMP(SSMPST(13)-
     *  1+I00001),I00002)*C00099(SSMP(SSMPST(13)-1+I00001),I00002)
      RS2=0.0
      DO 3 I00004=1,SSZ(7)
      RS2=RS2-C00026(SSMP(SSMPST(13)-1+I00001),I00004,I00002)*
     *  C00106(SSMP(SSMPST(13)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00280(I00001,I00002)=RS1+C00019(SSMP(SSMPST(13)-1+
     *  I00001),I00002)*C00076(SSMP(SSMPST(13)-1+I00001))*
     *  C00099(SSMP(SSMPST(13)-1+I00001),I00002)+RS2
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00280"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00260')
      RETURN
      END
      SUBROUTINE M00009(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(ECHO1.AND.DOIG(1153).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00231',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1153).NE.'n') then
      CALL S00211(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1153),
     *  C00048,C00049,C00231,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1155).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00232',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1155).NE.'n') then
      CALL S00212(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1155),
     *  C00048,C00049,C00232,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1157).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00233',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1157).NE.'n') then
      CALL S00213(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1157),
     *  C00048,C00049,C00087,C00089,C00090,C00233,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1159).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00234',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1159).NE.'n') then
      CALL S00214(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1159),
     *  C00048,C00049,C00076,C00087,C00089,C00090,C00234,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1161).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00235',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1161).NE.'n') then
      CALL S00215(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1161),
     *  C00048,C00049,C00076,C00087,C00089,C00090,C00235,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1163).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00236',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1163).NE.'n') then
      CALL S00216(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1163),
     *  C00048,C00049,C00087,C00089,C00090,C00151,C00236,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1165).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00237',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1165).NE.'n') then
      CALL S00217(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1165),
     *  C00087,C00089,C00090,C00231,C00237,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1167).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00238',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1167).NE.'n') then
      CALL S00218(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1167),
     *  C00048,C00087,C00089,C00090,C00238,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1169).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00239',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1169).NE.'n') then
      CALL S00219(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1169),
     *  C00087,C00089,C00090,C00232,C00239,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1171).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00240',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1171).NE.'n') then
      CALL S00220(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1171),
     *  C00048,C00049,C00087,C00089,C00090,C00240,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1173).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00241',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1173).NE.'n') then
      CALL S00221(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1173),
     *  C00048,C00049,C00087,C00089,C00090,C00241,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1175).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00242',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1175).NE.'n') then
      CALL S00222(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1175),
     *  C00048,C00049,C00063,C00065,C00076,C00086,C00090,C00242,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1177).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00243',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1177).NE.'n') then
      CALL S00223(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1177),
     *  C00048,C00049,C00065,C00076,C00088,C00090,C00243,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1179).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00244',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1179).NE.'n') then
      CALL S00224(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1179),
     *  C00065,C00234,C00244,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1181).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00245',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1181).NE.'n') then
      CALL S00225(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1181),
     *  C00065,C00245,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1183).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00246',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1183).NE.'n') then
      CALL S00226(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1183),
     *  C00048,C00049,C00065,C00066,C00076,C00086,C00090,C00217,
     *  C00246,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1185).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00247',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1185).NE.'n') then
      CALL S00227(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1185),
     *  C00048,C00049,C00065,C00066,C00076,C00088,C00090,C00217,
     *  C00247,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1187).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00248',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1187).NE.'n') then
      CALL S00228(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1187),
     *  C00065,C00066,C00217,C00234,C00248,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1189).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00249',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1189).NE.'n') then
      CALL S00229(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1189),
     *  C00031,C00045,C00053,C00054,C00055,C00056,C00058,C00059,
     *  C00060,C00061,C00063,C00064,C00065,C00066,C00068,C00070,
     *  C00072,C00074,C00200,C00217,C00249,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1191).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00250',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1191).NE.'n') then
      CALL S00230(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1191),
     *  C00065,C00066,C00217,C00250,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1193).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00251',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1193).NE.'n') then
      CALL S00231(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1193),
     *  C00048,C00049,C00065,C00066,C00076,C00086,C00090,C00217,
     *  C00251,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1195).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00252',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1195).NE.'n') then
      CALL S00232(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1195),
     *  C00048,C00049,C00065,C00066,C00076,C00088,C00090,C00217,
     *  C00252,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1197).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00253',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1197).NE.'n') then
      CALL S00233(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1197),
     *  C00065,C00066,C00217,C00234,C00253,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1199).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00254',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1199).NE.'n') then
      CALL S00234(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1199),
     *  C00065,C00066,C00217,C00254,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1201).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00255',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1201).NE.'n') then
      CALL S00235(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1201),
     *  C00065,C00066,C00217,C00255,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1203).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00256',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1203).NE.'n') then
      CALL S00236(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1203),
     *  C00053,C00054,C00055,C00056,C00058,C00059,C00060,C00061,
     *  C00063,C00064,C00065,C00066,C00068,C00070,C00072,C00074,
     *  C00217,C00256,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1205).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00257',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1205).NE.'n') then
      CALL S00237(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1205),
     *  C00053,C00054,C00055,C00056,C00058,C00059,C00060,C00061,
     *  C00063,C00064,C00065,C00066,C00070,C00072,C00074,C00217,
     *  C00257,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1207).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00258',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1207).NE.'n') then
      CALL S00238(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1207),
     *  C00091,C00095,C00258,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1209).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00259',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1209).NE.'n') then
      CALL S00239(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1209),
     *  C00091,C00095,C00259,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1211).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00260',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1211).NE.'n') then
      CALL S00240(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1211),
     *  C00091,C00096,C00260,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1213).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00261',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1213).NE.'n') then
      CALL S00241(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1213),
     *  C00050,C00095,C00230,C00261,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1215).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00262',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1215).NE.'n') then
      CALL S00242(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1215),
     *  C00050,C00095,C00262,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1217).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00263',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1217).NE.'n') then
      CALL S00243(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1217),
     *  C00050,C00096,C00263,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1219).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00264',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1219).NE.'n') then
      CALL S00244(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1219),
     *  C00050,C00096,C00264,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1221).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00265',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1221).NE.'n') then
      CALL S00245(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1221),
     *  C00060,C00076,C00100,C00265,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1223).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00266',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1223).NE.'n') then
      CALL S00246(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1223),
     *  C00060,C00095,C00266,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1225).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00267',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1225).NE.'n') then
      CALL S00247(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1225),
     *  C00060,C00095,C00267,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1227).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00268',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1227).NE.'n') then
      CALL S00248(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1227),
     *  C00060,C00076,C00096,C00268,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1229).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00269',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1229).NE.'n') then
      CALL S00249(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1229),
     *  C00060,C00061,C00076,C00100,C00217,C00248,C00269,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1231).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00270',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1231).NE.'n') then
      CALL S00250(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1231),
     *  C00060,C00061,C00095,C00217,C00249,C00270,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1233).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00271',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1233).NE.'n') then
      CALL S00251(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1233),
     *  C00060,C00061,C00095,C00217,C00271,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1235).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00272',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1235).NE.'n') then
      CALL S00252(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1235),
     *  C00060,C00061,C00076,C00096,C00217,C00272,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1237).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00273',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1237).NE.'n') then
      CALL S00253(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1237),
     *  C00060,C00061,C00076,C00100,C00217,C00273,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1239).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00274',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1239).NE.'n') then
      CALL S00254(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1239),
     *  C00060,C00061,C00095,C00217,C00274,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1241).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00275',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1241).NE.'n') then
      CALL S00255(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1241),
     *  C00060,C00061,C00095,C00217,C00275,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1243).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00276',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1243).NE.'n') then
      CALL S00256(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1243),
     *  C00060,C00061,C00076,C00096,C00217,C00276,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1245).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00277',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1245).NE.'n') then
      CALL S00257(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1245),
     *  C00060,C00061,C00095,C00217,C00256,C00277,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1247).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00278',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1247).NE.'n') then
      CALL S00258(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1247),
     *  C00010,C00013,C00016,C00024,C00076,C00086,C00090,C00097,
     *  C00104,C00278,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1249).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00279',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1249).NE.'n') then
      CALL S00259(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1249),
     *  C00010,C00013,C00016,C00019,C00024,C00076,C00087,C00089,
     *  C00098,C00100,C00105,C00234,C00279,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1251).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00280',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1251).NE.'n') then
      CALL S00260(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1251),
     *  C00013,C00019,C00026,C00076,C00088,C00090,C00099,C00106,
     *  C00280,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00009')
      RETURN
      END
      SUBROUTINE S00261(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00026,C00107,C00279,C00281,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL C00279(SSZ(13),SSZ(1))
      REAL C00281(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00281"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(13)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-C00026(SSMP(SSMPST(13)-1+I00001),I00004,I00002)*100.0 *
     *  C00107(SSMP(SSMPST(13)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00281(I00001,I00002)=RS1+C00279(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00281"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00261')
      RETURN
      END
      SUBROUTINE S00262(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00053,C00282,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00282(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00282"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00053(I00001,I00004,I00002)
    3 CONTINUE
      C00282(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00282"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00262')
      RETURN
      END
      SUBROUTINE S00263(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00076,C00106,C00283,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00283(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00283"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00055(I00001,I00004,I00002)*(1.0-C00076(I00001)*
     *  C00106(I00001,I00004,I00002))
    3 CONTINUE
      C00283(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00283"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00263')
      RETURN
      END
      SUBROUTINE S00264(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00076,C00107,C00284,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL C00284(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00284"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2-C00055(I00001,I00004,I00002)*C00076(I00001)*100.0 *
     *  C00107(I00001,I00004,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00284(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00284"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00264')
      RETURN
      END
      SUBROUTINE S00265(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00076,C00088,C00090,C00099,C00106,C00180,C00181,C00182,
     *  C00285,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00180(SSZ(2),SSZ(7),SSZ(1))
      REAL C00181(SSZ(2),SSZ(1))
      REAL C00182(SSZ(2),SSZ(1))
      REAL C00285(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00285"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00180(I00001,I00004,I00002)*C00076(I00001)*
     *  C00106(I00001,I00004,I00002)
    3 CONTINUE
      C00285(I00001,I00002)=C00182(I00001,I00002)*(C00076(I00001)*
     *  C00088(I00001,I00002)-(-1.0+C00076(I00001))*
     *  C00090(I00001,I00002)*C00088(I00001,I00002))+
     *  C00181(I00001,I00002)*C00076(I00001)*C00099(I00001,I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00285"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00265')
      RETURN
      END
      SUBROUTINE S00266(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00076,C00100,C00107,C00180,C00181,C00182,C00234,C00286,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL C00180(SSZ(2),SSZ(7),SSZ(1))
      REAL C00181(SSZ(2),SSZ(1))
      REAL C00182(SSZ(2),SSZ(1))
      REAL C00234(SSZ(2),SSZ(1))
      REAL C00286(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00286"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00180(I00001,I00004,I00002)*C00076(I00001)*100.0 *
     *  C00107(I00001,I00004,I00002)
    3 CONTINUE
      C00286(I00001,I00002)=RS1+C00181(I00001,I00002)*C00076(I00001)*
     *  100.0 *C00100(I00001,I00002)+C00182(I00001,I00002)*
     *  C00234(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00286"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00266')
      RETURN
      END
      SUBROUTINE S00267(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00026,C00076,C00106,C00280,C00287,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00280(SSZ(13),SSZ(1))
      REAL C00287(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00287"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(13)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00026(SSMP(SSMPST(13)-1+I00001),I00004,I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))*C00106(SSMP(SSMPST(13)-1+
     *  I00001),I00004,I00002)
    3 CONTINUE
      C00287(I00001,I00002)=C00280(I00001,I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00287"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00267')
      RETURN
      END
      SUBROUTINE S00268(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00026,C00076,C00107,C00281,C00288,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL C00281(SSZ(13),SSZ(1))
      REAL C00288(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00288"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(13)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00026(SSMP(SSMPST(13)-1+I00001),I00004,I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))*100.0 *C00107(SSMP(SSMPST(13)-
     *  1+I00001),I00004,I00002)
    3 CONTINUE
      C00288(I00001,I00002)=RS1+C00281(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00288"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00268')
      RETURN
      END
      SUBROUTINE S00269(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00013,C00019,C00026,C00076,C00088,C00090,C00099,C00106,
     *  C00289,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00289(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00289"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(13)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00026(SSMP(SSMPST(13)-1+I00001),I00004,I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))*C00106(SSMP(SSMPST(13)-1+
     *  I00001),I00004,I00002)
    3 CONTINUE
      C00289(I00001,I00002)=C00013(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  (C00076(SSMP(SSMPST(13)-1+I00001))*C00088(SSMP(SSMPST(13)-1+
     *  I00001),I00002)-(-1.0+C00076(SSMP(SSMPST(13)-1+I00001)))*
     *  C00090(SSMP(SSMPST(13)-1+I00001),I00002)*C00088(SSMP(SSMPST(13)-
     *  1+I00001),I00002))+C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))*C00099(SSMP(SSMPST(13)-1+
     *  I00001),I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00289"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00269')
      RETURN
      END
      SUBROUTINE S00270(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00013,C00019,C00026,C00076,C00100,C00107,C00234,C00290,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL C00234(SSZ(2),SSZ(1))
      REAL C00290(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00290"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(13)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00026(SSMP(SSMPST(13)-1+I00001),I00004,I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))*100.0 *C00107(SSMP(SSMPST(13)-
     *  1+I00001),I00004,I00002)
    3 CONTINUE
      C00290(I00001,I00002)=RS1+C00019(SSMP(SSMPST(13)-1+
     *  I00001),I00002)*C00076(SSMP(SSMPST(13)-1+I00001))*100.0 *
     *  C00100(SSMP(SSMPST(13)-1+I00001),I00002)+C00013(SSMP(SSMPST(13)-
     *  1+I00001),I00002)*C00234(SSMP(SSMPST(13)-1+I00001),I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00290"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00270')
      RETURN
      END
      SUBROUTINE S00271(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00056,C00060,C00061,C00076,C00099,C00106,C00217,
     *  C00247,C00291,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00247(SSZ(2),SSZ(1))
      REAL C00291(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00291"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+0.01  *C00217(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*C00076(I00001)*
     *  C00106(I00001,I00004,I00002)
    3 CONTINUE
      C00291(I00001,I00002)=C00247(I00001,I00002)+0.01  *C00217(I00002)*
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*C00076(I00001)*
     *  C00099(I00001,I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00291"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00271')
      RETURN
      END
      SUBROUTINE S00272(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00056,C00076,C00107,C00217,C00269,C00292,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00269(SSZ(1))
      REAL C00292(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00292"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2+0.01  *C00217(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*C00076(I00001)*100.0 *
     *  C00107(I00001,I00004,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00292(I00002)=RS1+C00269(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00292"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00272')
      RETURN
      END
      SUBROUTINE S00273(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00056,C00076,C00106,C00217,C00293,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00293(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00293"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00217(I00002)*
     *  C00076(I00001)*C00106(I00001,I00004,I00002)
    3 CONTINUE
      C00293(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00293"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00273')
      RETURN
      END
      SUBROUTINE S00274(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00056,C00076,C00107,C00217,C00294,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00294(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00294"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00217(I00002)*
     *  C00076(I00001)*100.0 *C00107(I00001,I00004,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00294(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00294"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00274')
      RETURN
      END
      SUBROUTINE S00275(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00056,C00217,C00295,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00295(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00295"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00217(I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00295(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00295"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00275')
      RETURN
      END
      SUBROUTINE S00276(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00056,C00076,C00107,C00217,C00296,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00296(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00296"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00217(I00002)*
     *  C00076(I00001)*100.0 *C00107(I00001,I00004,I00002)
    3 CONTINUE
      C00296(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00296"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00276')
      RETURN
      END
      SUBROUTINE S00277(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00056,C00217,C00297,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00297(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00297"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00217(I00002)
    3 CONTINUE
      C00297(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00297"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00277')
      RETURN
      END
      SUBROUTINE S00278(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00056,C00060,C00061,C00065,C00066,C00076,C00088,
     *  C00090,C00099,C00106,C00217,C00298,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00298(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00298"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+0.01  *C00217(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*C00076(I00001)*
     *  C00106(I00001,I00004,I00002)
    3 CONTINUE
      C00298(I00001,I00002)=0.01  *C00217(I00002)*
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))*(C00076(I00001)*
     *  C00088(I00001,I00002)-(-1.0+C00076(I00001))*
     *  C00090(I00001,I00002)*C00088(I00001,I00002))+0.01  *
     *  C00217(I00002)*(C00060(I00001,I00002)+C00061(I00001,I00002))*
     *  C00076(I00001)*C00099(I00001,I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00298"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00278')
      RETURN
      END
      SUBROUTINE S00279(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00055,C00056,C00060,C00061,C00065,C00066,C00076,C00100,
     *  C00107,C00217,C00234,C00299,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00234(SSZ(2),SSZ(1))
      REAL C00299(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00299"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+0.01  *C00217(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*C00076(I00001)*100.0 *
     *  C00107(I00001,I00004,I00002)
    3 CONTINUE
      C00299(I00001,I00002)=RS1+0.01  *C00217(I00002)*
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*C00076(I00001)*
     *  100.0 *C00100(I00001,I00002)+0.01  *C00217(I00002)*
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))*
     *  C00234(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00299"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00279')
      RETURN
      END
      SUBROUTINE S00280(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00045,C00217,C00300,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00300(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00300"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(7)
      RS1=RS1-0.01  *C00217(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
    2 CONTINUE
      C00300(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00300"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00280')
      RETURN
      END
      SUBROUTINE S00281(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00045,C00217,C00301,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00301(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00301"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(7)
      RS1=RS1+C00045(SSMP(SSMPST(9)-1+I00001),I00002)
    2 CONTINUE
      C00301(I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00301"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00281')
      RETURN
      END
      SUBROUTINE S00282(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00110,C00302,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00110(SSZ(18),SSZ(7),SSZ(1))
      REAL C00302(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00302"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00008=1,SSZ(18)
      RS1=RS1-C00110(I00008,I00004,I00002)
    3 CONTINUE
      C00302(I00004,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00302"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00282')
      RETURN
      END
      SUBROUTINE S00283(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00113,C00303,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00113(SSZ(20),SSZ(7),SSZ(1))
      REAL C00303(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00303"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00008=1,SSZ(20)
      RS1=RS1-C00113(I00008,I00004,I00002)
    3 CONTINUE
      C00303(I00004,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00303"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00283')
      RETURN
      END
      SUBROUTINE S00284(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00116,C00304,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(22),SSZ(7),SSZ(1))
      REAL C00304(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00304"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00008=1,SSZ(22)
      RS1=RS1-C00116(I00008,I00004,I00002)
    3 CONTINUE
      C00304(I00004,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00304"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00284')
      RETURN
      END
      SUBROUTINE S00285(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00119,C00305,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00119(SSZ(24),SSZ(7),SSZ(1))
      REAL C00305(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00305"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00008=1,SSZ(24)
      RS1=RS1-C00119(I00008,I00004,I00002)
    3 CONTINUE
      C00305(I00004,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00305"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00285')
      RETURN
      END
      SUBROUTINE S00286(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00122,C00306,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00122(SSZ(26),SSZ(7),SSZ(1))
      REAL C00306(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00306"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00008=1,SSZ(26)
      RS1=RS1-C00122(I00008,I00004,I00002)
    3 CONTINUE
      C00306(I00004,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00306"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00286')
      RETURN
      END
      SUBROUTINE S00287(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00127,C00307,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00127(SSZ(28),SSZ(7),SSZ(1))
      REAL C00307(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00307"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00001=1,SSZ(28)
      RS1=RS1+C00127(I00001,I00004,I00002)
    3 CONTINUE
      C00307(I00004,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00307"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00287')
      RETURN
      END
      SUBROUTINE S00288(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00217,C00308,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00308(SSZ(17),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00308"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(17)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-0.01  *C00217(I00002)*C00102(I00001,I00004,I00002)
    3 CONTINUE
      C00308(I00001,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00308"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00288')
      RETURN
      END
      SUBROUTINE S00289(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00217,C00309,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00309(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00309"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00001=1,SSZ(17)
      RS1=RS1-0.01  *C00217(I00002)*C00102(I00001,I00004,I00002)
    3 CONTINUE
      C00309(I00004,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00309"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00289')
      RETURN
      END
      SUBROUTINE S00290(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00217,C00310,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00310(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00310"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS2=0.0
      DO 2 I00001=1,SSZ(17)
      RS2=RS2-0.01  *C00217(I00002)*C00102(I00001,I00004,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00310(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00310"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00290')
      RETURN
      END
      SUBROUTINE S00291(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00217,C00311,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00311(SSZ(17),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00311"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(17)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00102(I00001,I00004,I00002)
    3 CONTINUE
      C00311(I00001,I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00311"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00291')
      RETURN
      END
      SUBROUTINE S00292(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00217,C00312,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00312(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00312"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(7)
      RS1=0.0
      DO 3 I00001=1,SSZ(17)
      RS1=RS1+C00102(I00001,I00004,I00002)
    3 CONTINUE
      C00312(I00004,I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00312"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00292')
      RETURN
      END
      SUBROUTINE S00293(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00102,C00217,C00313,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00313(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00313"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00004=1,SSZ(7)
      RS2=0.0
      DO 3 I00001=1,SSZ(17)
      RS2=RS2+C00102(I00001,I00004,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    2 CONTINUE
      C00313(I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00313"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00293')
      RETURN
      END
      SUBROUTINE S00294(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00068,C00314,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00314(SSZ(11),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00314"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(11)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+C00068(SSMP(SSMPST(11)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00314(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00314"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00294')
      RETURN
      END
      SUBROUTINE S00295(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00068,C00217,C00315,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00315(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00315"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS2=0.0
      DO 2 I00001=1,SSZ(6)
      RS2=RS2-C00068(I00001,I00004,I00002)*0.01  *C00217(I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00315(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00315"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00295')
      RETURN
      END
      SUBROUTINE S00296(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00068,C00217,C00316,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00316(SSZ(6),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00316"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(6)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-C00068(I00001,I00004,I00002)*0.01  *C00217(I00002)
    3 CONTINUE
      C00316(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00316"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00296')
      RETURN
      END
      SUBROUTINE S00297(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00068,C00070,C00217,C00317,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00317(SSZ(6),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00317"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(6)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-C00068(I00001,I00004,I00002)
    3 CONTINUE
      C00317(I00001,I00002)=-0.01  *C00217(I00002)*(-
     *  C00070(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)+RS1)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00317"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00297')
      RETURN
      END
      SUBROUTINE S00298(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00072,C00318,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00318(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00318"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00072(I00001,I00002,I00003)
    3 CONTINUE
      C00318(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00318"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00298')
      RETURN
      END
      SUBROUTINE S00299(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00035,C00072,C00319,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00319(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00319"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00035(I00001,I00002,I00003)-C00072(I00001,I00002,I00003)
    3 CONTINUE
      C00319(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00319"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00299')
      RETURN
      END
      SUBROUTINE S00300(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00320,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00320(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00320"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(I00001,I00002,I00003)
    3 CONTINUE
      C00320(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00320"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00300')
      RETURN
      END
      SUBROUTINE S00301(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00321,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00321(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00321"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00034(I00001,I00002,I00003)
    3 CONTINUE
      C00321(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00321"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00301')
      RETURN
      END
      SUBROUTINE S00302(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00086,C00090,C00231,C00322,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00231(SSZ(2),SSZ(1))
      REAL C00322(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00322"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00034(I00001,I00002,I00003)
    3 CONTINUE
      C00322(I00001,I00002)=C00231(I00001,I00002)*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00322"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00302')
      RETURN
      END
      SUBROUTINE S00303(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00323,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00323(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00323"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(I00001,I00002,I00003)
    3 CONTINUE
      C00323(I00001,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00323"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00303')
      RETURN
      END
      SUBROUTINE S00304(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00048,C00086,C00090,C00324,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00324(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00324"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00034(I00001,I00002,I00003)
    3 CONTINUE
      C00324(I00001,I00002)=-C00048(I00001,I00002)*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00324"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00304')
      RETURN
      END
      SUBROUTINE S00305(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00036,C00325,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00325(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00325"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00325(I00005,I00002)=-(RS1+C00036(I00005,I00002))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00325"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00305')
      RETURN
      END
      SUBROUTINE S00306(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00326,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00326(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00326"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00326(I00005,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00326"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00306')
      RETURN
      END
      SUBROUTINE S00307(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00327,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00327(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00327"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00327(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00327"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00307')
      RETURN
      END
      SUBROUTINE S00308(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00328,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00328(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00328"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00328(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00328"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00308')
      RETURN
      END
      SUBROUTINE S00309(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00217,C00246,C00329,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00246(SSZ(2),SSZ(1))
      REAL C00329(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00329"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-0.01  *C00217(I00002)*C00034(I00001,I00002,I00003)
    3 CONTINUE
      C00329(I00001,I00002)=C00246(I00001,I00002)+RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00329"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00309')
      RETURN
      END
      SUBROUTINE S00310(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00217,C00330,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00330(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00330"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+0.01  *C00217(I00002)*C00034(I00001,I00002,I00003)
    3 CONTINUE
      C00330(I00001,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00330"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00310')
      RETURN
      END
      SUBROUTINE M00010(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(ECHO1.AND.DOIG(1253).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00281',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1253).NE.'n') then
      CALL S00261(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1253),
     *  C00026,C00107,C00279,C00281,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1255).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00282',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1255).NE.'n') then
      CALL S00262(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1255),
     *  C00053,C00282,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1257).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00283',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1257).NE.'n') then
      CALL S00263(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1257),
     *  C00055,C00076,C00106,C00283,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1259).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00284',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1259).NE.'n') then
      CALL S00264(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1259),
     *  C00055,C00076,C00107,C00284,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1261).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00285',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1261).NE.'n') then
      CALL S00265(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1261),
     *  C00076,C00088,C00090,C00099,C00106,C00180,C00181,C00182,
     *  C00285,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1263).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00286',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1263).NE.'n') then
      CALL S00266(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1263),
     *  C00076,C00100,C00107,C00180,C00181,C00182,C00234,C00286,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1265).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00287',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1265).NE.'n') then
      CALL S00267(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1265),
     *  C00026,C00076,C00106,C00280,C00287,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1267).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00288',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1267).NE.'n') then
      CALL S00268(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1267),
     *  C00026,C00076,C00107,C00281,C00288,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1269).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00289',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1269).NE.'n') then
      CALL S00269(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1269),
     *  C00013,C00019,C00026,C00076,C00088,C00090,C00099,C00106,
     *  C00289,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1271).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00290',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1271).NE.'n') then
      CALL S00270(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1271),
     *  C00013,C00019,C00026,C00076,C00100,C00107,C00234,C00290,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1273).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00291',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1273).NE.'n') then
      CALL S00271(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1273),
     *  C00055,C00056,C00060,C00061,C00076,C00099,C00106,C00217,
     *  C00247,C00291,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1275).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00292',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1275).NE.'n') then
      CALL S00272(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1275),
     *  C00055,C00056,C00076,C00107,C00217,C00269,C00292,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1277).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00293',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1277).NE.'n') then
      CALL S00273(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1277),
     *  C00055,C00056,C00076,C00106,C00217,C00293,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1279).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00294',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1279).NE.'n') then
      CALL S00274(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1279),
     *  C00055,C00056,C00076,C00107,C00217,C00294,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1281).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00295',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1281).NE.'n') then
      CALL S00275(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1281),
     *  C00055,C00056,C00217,C00295,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1283).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00296',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1283).NE.'n') then
      CALL S00276(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1283),
     *  C00055,C00056,C00076,C00107,C00217,C00296,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1285).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00297',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1285).NE.'n') then
      CALL S00277(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1285),
     *  C00055,C00056,C00217,C00297,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1287).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00298',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1287).NE.'n') then
      CALL S00278(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1287),
     *  C00055,C00056,C00060,C00061,C00065,C00066,C00076,C00088,
     *  C00090,C00099,C00106,C00217,C00298,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1289).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00299',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1289).NE.'n') then
      CALL S00279(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1289),
     *  C00055,C00056,C00060,C00061,C00065,C00066,C00076,C00100,
     *  C00107,C00217,C00234,C00299,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1291).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00300',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1291).NE.'n') then
      CALL S00280(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1291),
     *  C00045,C00217,C00300,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1293).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00301',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1293).NE.'n') then
      CALL S00281(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1293),
     *  C00045,C00217,C00301,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1295).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00302',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1295).NE.'n') then
      CALL S00282(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1295),
     *  C00110,C00302,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1297).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00303',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1297).NE.'n') then
      CALL S00283(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1297),
     *  C00113,C00303,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1299).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00304',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1299).NE.'n') then
      CALL S00284(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1299),
     *  C00116,C00304,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1301).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00305',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1301).NE.'n') then
      CALL S00285(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1301),
     *  C00119,C00305,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1303).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00306',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1303).NE.'n') then
      CALL S00286(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1303),
     *  C00122,C00306,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1305).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00307',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1305).NE.'n') then
      CALL S00287(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1305),
     *  C00127,C00307,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1307).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00308',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1307).NE.'n') then
      CALL S00288(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1307),
     *  C00102,C00217,C00308,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1309).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00309',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1309).NE.'n') then
      CALL S00289(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1309),
     *  C00102,C00217,C00309,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1311).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00310',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1311).NE.'n') then
      CALL S00290(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1311),
     *  C00102,C00217,C00310,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1313).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00311',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1313).NE.'n') then
      CALL S00291(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1313),
     *  C00102,C00217,C00311,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1315).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00312',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1315).NE.'n') then
      CALL S00292(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1315),
     *  C00102,C00217,C00312,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1317).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00313',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1317).NE.'n') then
      CALL S00293(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1317),
     *  C00102,C00217,C00313,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1319).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00314',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1319).NE.'n') then
      CALL S00294(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1319),
     *  C00068,C00314,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1321).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00315',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1321).NE.'n') then
      CALL S00295(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1321),
     *  C00068,C00217,C00315,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1323).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00316',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1323).NE.'n') then
      CALL S00296(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1323),
     *  C00068,C00217,C00316,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1325).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00317',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1325).NE.'n') then
      CALL S00297(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1325),
     *  C00068,C00070,C00217,C00317,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1327).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00318',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1327).NE.'n') then
      CALL S00298(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1327),
     *  C00072,C00318,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1329).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00319',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1329).NE.'n') then
      CALL S00299(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1329),
     *  C00035,C00072,C00319,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1331).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00320',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1331).NE.'n') then
      CALL S00300(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1331),
     *  C00034,C00320,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1333).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00321',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1333).NE.'n') then
      CALL S00301(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1333),
     *  C00034,C00321,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1335).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00322',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1335).NE.'n') then
      CALL S00302(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1335),
     *  C00034,C00086,C00090,C00231,C00322,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1337).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00323',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1337).NE.'n') then
      CALL S00303(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1337),
     *  C00034,C00323,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1339).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00324',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1339).NE.'n') then
      CALL S00304(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1339),
     *  C00034,C00048,C00086,C00090,C00324,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1341).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00325',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1341).NE.'n') then
      CALL S00305(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1341),
     *  C00034,C00036,C00325,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1343).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00326',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1343).NE.'n') then
      CALL S00306(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1343),
     *  C00034,C00326,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1345).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00327',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1345).NE.'n') then
      CALL S00307(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1345),
     *  C00034,C00327,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1347).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00328',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1347).NE.'n') then
      CALL S00308(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1347),
     *  C00034,C00328,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1349).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00329',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1349).NE.'n') then
      CALL S00309(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1349),
     *  C00034,C00217,C00246,C00329,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1351).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00330',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1351).NE.'n') then
      CALL S00310(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1351),
     *  C00034,C00217,C00330,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00010')
      RETURN
      END
      SUBROUTINE S00311(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00217,C00331,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00331(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00331"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00034(I00001,I00002,I00003)
    3 CONTINUE
      C00331(I00001,I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00331"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00311')
      RETURN
      END
      SUBROUTINE S00312(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00217,C00332,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00332(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00332"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00034(I00001,I00002,I00003)
    3 CONTINUE
      C00332(I00001,I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00332"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00312')
      RETURN
      END
      SUBROUTINE S00313(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00036,C00217,C00218,C00333,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00218(SSZ(3),SSZ(1))
      REAL C00333(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00333"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2-C00034(I00001,I00002,I00003)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      RS3=0.0
      DO 4 I00005=1,SSZ(3)
      RS3=RS3-C00036(I00005,I00002)
    4 CONTINUE
      RS4=0.0
      DO 6 I00003=1,SSZ(1)
      RS5=0.0
      DO 5 I00001=1,SSZ(2)
      RS5=RS5-C00034(I00001,I00003,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    6 CONTINUE
      RS6=0.0
      DO 7 I00005=1,SSZ(3)
      RS6=RS6-C00218(I00005,I00002)
    7 CONTINUE
      C00333(I00002)=-0.01  *C00217(I00002)*(RS1+RS3-RS4-RS6)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00333"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00313')
      RETURN
      END
      SUBROUTINE S00314(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00224,C00225,C00334,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00224(SSZ(2),SSZ(1),SSZ(1))
      REAL C00225(SSZ(3),SSZ(1))
      REAL C00334(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00334"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00224(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00334(I00005,I00002)=-(RS1+C00225(I00005,I00002))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00334"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00314')
      RETURN
      END
      SUBROUTINE S00315(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00224,C00335,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00224(SSZ(2),SSZ(1),SSZ(1))
      REAL C00335(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00335"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00224(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00335(I00005,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00335"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00315')
      RETURN
      END
      SUBROUTINE S00316(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00224,C00336,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00224(SSZ(2),SSZ(1),SSZ(1))
      REAL C00336(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00336"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00224(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00336(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00336"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00316')
      RETURN
      END
      SUBROUTINE S00317(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00224,C00337,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00224(SSZ(2),SSZ(1),SSZ(1))
      REAL C00337(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00337"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00224(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00337(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00337"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00317')
      RETURN
      END
      SUBROUTINE S00318(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00133,C00338,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00133(SSZ(2),SSZ(1),SSZ(1))
      REAL C00338(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00338"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)
      RS1=RS1+C00133(I00001,I00008,I00003)
    3 CONTINUE
      C00338(I00001,I00003)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00338"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00318')
      RETURN
      END
      SUBROUTINE S00319(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00141,C00339,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00141(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00339(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00339"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00002=1,SSZ(1)
      RS3=0.0
      DO 2 I00001=1,SSZ(2)
      RS3=RS3+C00141(I00005,I00001,I00002,I00003)
    2 CONTINUE
      RS2=RS2+RS3
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00339(I00005)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00339"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00319')
      RETURN
      END
      SUBROUTINE S00320(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00141,C00340,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00141(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00340(SSZ(3),SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00340"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00001=1,SSZ(2)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00002=1,SSZ(1)
      RS2=RS2+C00141(I00005,I00001,I00002,I00003)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00340(I00005,I00001)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00340"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00320')
      RETURN
      END
      SUBROUTINE S00321(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00141,C00341,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00141(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00341(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00341"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00141(I00005,I00001,I00002,I00003)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00341(I00005,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00341"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00321')
      RETURN
      END
      SUBROUTINE S00322(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00141,C00342,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00141(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00342(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00342"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00141(I00005,I00001,I00002,I00003)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00342(I00005,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00342"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00322')
      RETURN
      END
      SUBROUTINE S00323(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00144,C00147,C00343,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00343"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 4 I00005=1,SSZ(3)
      RS1=RS1+C00147(I00001,I00002,I00003)*
     *  C00144(I00005,I00001,I00002,I00003)
    4 CONTINUE
      C00343(I00001,I00002,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00343"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00323')
      RETURN
      END
      SUBROUTINE S00324(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00217,C00344,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00344(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00344"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2-0.01  *C00217(I00002)*C00135(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00344(I00005,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00344"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00324')
      RETURN
      END
      SUBROUTINE S00325(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00217,C00345,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00345(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00345"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00005=1,SSZ(3)
      RS2=RS2-0.01  *C00217(I00002)*C00135(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00345(I00001,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00345"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00325')
      RETURN
      END
      SUBROUTINE S00326(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00217,C00346,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00346(SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00346"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00003=1,SSZ(1)
      RS1=0.0
      DO 4 I00001=1,SSZ(2)
      RS2=0.0
      DO 3 I00005=1,SSZ(3)
      RS2=RS2-0.01  *C00217(I00002)*C00135(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00346(I00003,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00346"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00326')
      RETURN
      END
      SUBROUTINE S00327(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00217,C00347,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00347(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00347"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS3=0.0
      DO 2 I00005=1,SSZ(3)
      RS3=RS3-0.01  *C00217(I00002)*C00135(I00005,I00001,I00003,I00002)
    2 CONTINUE
      RS2=RS2+RS3
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00347(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00347"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00327')
      RETURN
      END
      SUBROUTINE S00328(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00217,C00348,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00348(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00348"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00135(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00348(I00005,I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00348"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00328')
      RETURN
      END
      SUBROUTINE S00329(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00217,C00349,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00349(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00349"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00005=1,SSZ(3)
      RS2=RS2+C00135(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00349(I00001,I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00349"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00329')
      RETURN
      END
      SUBROUTINE S00330(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00217,C00350,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00350(SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00350"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00003=1,SSZ(1)
      RS1=0.0
      DO 4 I00001=1,SSZ(2)
      RS2=0.0
      DO 3 I00005=1,SSZ(3)
      RS2=RS2+C00135(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00350(I00003,I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00350"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00330')
      RETURN
      END
      SUBROUTINE S00331(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00135,C00217,C00351,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00351(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00351"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS3=0.0
      DO 2 I00005=1,SSZ(3)
      RS3=RS3+C00135(I00005,I00001,I00003,I00002)
    2 CONTINUE
      RS2=RS2+RS3
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00351(I00002)=-0.01  *C00217(I00002)*RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00351"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00331')
      RETURN
      END
      SUBROUTINE S00332(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00133,C00144,C00147,C00352,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00133(SSZ(2),SSZ(1),SSZ(1))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00352(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00352"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00008=1,SSZ(1)
      RS1=RS1+C00133(I00001,I00008,I00003)*C00147(I00001,I00008,I00003)*
     *  C00144(I00005,I00001,I00008,I00003)
    4 CONTINUE
      C00352(I00005,I00001,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00352"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00332')
      RETURN
      END
      SUBROUTINE S00333(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00133,C00343,C00353,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00133(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL C00353(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00353"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)
      RS1=RS1+C00133(I00001,I00008,I00003)*C00343(I00001,I00008,I00003)
    3 CONTINUE
      C00353(I00001,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00353"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00333')
      RETURN
      END
      SUBROUTINE S00334(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00133,C00144,C00147,C00354,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00133(SSZ(2),SSZ(1),SSZ(1))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00354(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00354"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00008=1,SSZ(1)
      RS1=RS1-C00133(I00001,I00008,I00003)*C00147(I00001,I00008,I00003)*
     *  C00144(I00005,I00001,I00008,I00003)
    4 CONTINUE
      C00354(I00005,I00001,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00354"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00334')
      RETURN
      END
      SUBROUTINE S00335(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00032,C00355,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00355(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00355"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00032(I00001,I00003,I00002)
    3 CONTINUE
      C00355(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00355"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00335')
      RETURN
      END
      SUBROUTINE S00336(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00074,C00144,C00147,C00356,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00356(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00356"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2-C00074(I00001,I00003,I00002)*C00147(I00001,I00003,I00002)*
     *  C00144(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00356(I00005,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00356"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00336')
      RETURN
      END
      SUBROUTINE S00337(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00074,C00343,C00357,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL C00357(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00357"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00074(I00001,I00003,I00002)*C00343(I00001,I00003,I00002)
    3 CONTINUE
      C00357(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00357"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00337')
      RETURN
      END
      SUBROUTINE S00338(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00074,C00343,C00358,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL C00358(SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00358"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00003=1,SSZ(1)
      RS1=0.0
      DO 3 I00001=1,SSZ(2)
      RS1=RS1-C00074(I00001,I00003,I00002)*C00343(I00001,I00003,I00002)
    3 CONTINUE
      C00358(I00003,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00358"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00338')
      RETURN
      END
      SUBROUTINE S00339(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00074,C00343,C00359,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL C00359(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00359"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2-C00074(I00001,I00003,I00002)*C00343(I00001,I00003,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00359(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00359"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00339')
      RETURN
      END
      SUBROUTINE S00340(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00074,C00144,C00147,C00360,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00360(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00360"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00074(I00001,I00003,I00002)*C00147(I00001,I00003,I00002)*
     *  C00144(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00360(I00005,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00360"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00340')
      RETURN
      END
      SUBROUTINE S00341(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00144,C00147,C00361,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00361(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00361"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00008=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2-C00033(I00001,I00008,I00002)*C00147(I00001,I00008,I00002)*
     *  C00144(I00005,I00001,I00008,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00361(I00005,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00361"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00341')
      RETURN
      END
      SUBROUTINE S00342(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00343,C00362,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL C00362(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00362"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)
      RS1=RS1-C00033(I00001,I00008,I00002)*C00343(I00001,I00008,I00002)
    3 CONTINUE
      C00362(I00001,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00362"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00342')
      RETURN
      END
      SUBROUTINE S00343(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00343,C00363,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL C00363(SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00363"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00008=1,SSZ(1)
      RS1=0.0
      DO 3 I00001=1,SSZ(2)
      RS1=RS1-C00033(I00001,I00008,I00002)*C00343(I00001,I00008,I00002)
    3 CONTINUE
      C00363(I00008,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00363"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00343')
      RETURN
      END
      SUBROUTINE S00344(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00343,C00364,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL C00364(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00364"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2-C00033(I00001,I00008,I00002)*C00343(I00001,I00008,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00364(I00002)=-RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00364"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00344')
      RETURN
      END
      SUBROUTINE S00345(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00144,C00147,C00365,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00365(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00365"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00008=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00033(I00001,I00008,I00002)*C00147(I00001,I00008,I00002)*
     *  C00144(I00005,I00001,I00008,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00365(I00005,I00002)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00365"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00345')
      RETURN
      END
      SUBROUTINE S00346(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00144,C00147,C00366,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00366(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00366"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2-C00033(I00001,I00003,I00002)*C00147(I00001,I00003,I00002)*
     *  C00144(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00366(I00005,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00366"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00346')
      RETURN
      END
      SUBROUTINE S00347(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00343,C00367,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL C00367(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00367"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00033(I00001,I00003,I00002)*C00343(I00001,I00003,I00002)
    3 CONTINUE
      C00367(I00001,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00367"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00347')
      RETURN
      END
      SUBROUTINE S00348(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00343,C00368,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL C00368(SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00368"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00003=1,SSZ(1)
      RS1=0.0
      DO 3 I00001=1,SSZ(2)
      RS1=RS1-C00033(I00001,I00003,I00002)*C00343(I00001,I00003,I00002)
    3 CONTINUE
      C00368(I00003,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00368"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00348')
      RETURN
      END
      SUBROUTINE S00349(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00343,C00369,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL C00369(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00369"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2-C00033(I00001,I00003,I00002)*C00343(I00001,I00003,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00369(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00369"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00349')
      RETURN
      END
      SUBROUTINE S00350(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00144,C00147,C00370,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00370(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00370"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00033(I00001,I00003,I00002)*C00147(I00001,I00003,I00002)*
     *  C00144(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00370(I00005,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00370"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00350')
      RETURN
      END
      SUBROUTINE S00351(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00144,C00147,C00371,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00371(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00371"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)
      RS1=RS1-C00033(I00001,I00002,I00003)*C00147(I00001,I00002,I00003)*
     *  C00144(I00005,I00001,I00002,I00003)
    4 CONTINUE
      C00371(I00005,I00001,I00003)=-RS1
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00371"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00351')
      RETURN
      END
      SUBROUTINE S00352(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00343,C00372,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL C00372(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00372"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS1=RS1-C00033(I00001,I00002,I00003)*C00343(I00001,I00002,I00003)
    3 CONTINUE
      C00372(I00001,I00003)=-RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00372"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00352')
      RETURN
      END
      SUBROUTINE S00353(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00033,C00144,C00147,C00373,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00373(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00373"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      DO 1 I00005=1,SSZ(3)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)
      RS1=RS1+C00033(I00001,I00002,I00003)*C00147(I00001,I00002,I00003)*
     *  C00144(I00005,I00001,I00002,I00003)
    4 CONTINUE
      C00373(I00005,I00001,I00003)=-RS1
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "C00373"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00353')
      RETURN
      END
      SUBROUTINE M00011(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(ECHO1.AND.DOIG(1353).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00331',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1353).NE.'n') then
      CALL S00311(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1353),
     *  C00034,C00217,C00331,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1355).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00332',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1355).NE.'n') then
      CALL S00312(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1355),
     *  C00034,C00217,C00332,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1357).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00333',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1357).NE.'n') then
      CALL S00313(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1357),
     *  C00034,C00036,C00217,C00218,C00333,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1359).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00334',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1359).NE.'n') then
      CALL S00314(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1359),
     *  C00224,C00225,C00334,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1361).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00335',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1361).NE.'n') then
      CALL S00315(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1361),
     *  C00224,C00335,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1363).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00336',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1363).NE.'n') then
      CALL S00316(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1363),
     *  C00224,C00336,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1365).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00337',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1365).NE.'n') then
      CALL S00317(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1365),
     *  C00224,C00337,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1367).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00338',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1367).NE.'n') then
      CALL S00318(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1367),
     *  C00133,C00338,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1369).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00339',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1369).NE.'n') then
      CALL S00319(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1369),
     *  C00141,C00339,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1371).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00340',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1371).NE.'n') then
      CALL S00320(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1371),
     *  C00141,C00340,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1373).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00341',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1373).NE.'n') then
      CALL S00321(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1373),
     *  C00141,C00341,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1375).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00342',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1375).NE.'n') then
      CALL S00322(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1375),
     *  C00141,C00342,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1377).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00343',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1377).NE.'n') then
      CALL S00323(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1377),
     *  C00144,C00147,C00343,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1379).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00344',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1379).NE.'n') then
      CALL S00324(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1379),
     *  C00135,C00217,C00344,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1381).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00345',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1381).NE.'n') then
      CALL S00325(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1381),
     *  C00135,C00217,C00345,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1383).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00346',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1383).NE.'n') then
      CALL S00326(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1383),
     *  C00135,C00217,C00346,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1385).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00347',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1385).NE.'n') then
      CALL S00327(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1385),
     *  C00135,C00217,C00347,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1387).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00348',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1387).NE.'n') then
      CALL S00328(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1387),
     *  C00135,C00217,C00348,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1389).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00349',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1389).NE.'n') then
      CALL S00329(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1389),
     *  C00135,C00217,C00349,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1391).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00350',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1391).NE.'n') then
      CALL S00330(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1391),
     *  C00135,C00217,C00350,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1393).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00351',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1393).NE.'n') then
      CALL S00331(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1393),
     *  C00135,C00217,C00351,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1395).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00352',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1395).NE.'n') then
      CALL S00332(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1395),
     *  C00133,C00144,C00147,C00352,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1397).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00353',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1397).NE.'n') then
      CALL S00333(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1397),
     *  C00133,C00343,C00353,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1399).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00354',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1399).NE.'n') then
      CALL S00334(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1399),
     *  C00133,C00144,C00147,C00354,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1401).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00355',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1401).NE.'n') then
      CALL S00335(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1401),
     *  C00032,C00355,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1403).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00356',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1403).NE.'n') then
      CALL S00336(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1403),
     *  C00074,C00144,C00147,C00356,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1405).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00357',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1405).NE.'n') then
      CALL S00337(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1405),
     *  C00074,C00343,C00357,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1407).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00358',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1407).NE.'n') then
      CALL S00338(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1407),
     *  C00074,C00343,C00358,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1409).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00359',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1409).NE.'n') then
      CALL S00339(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1409),
     *  C00074,C00343,C00359,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1411).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00360',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1411).NE.'n') then
      CALL S00340(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1411),
     *  C00074,C00144,C00147,C00360,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1413).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00361',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1413).NE.'n') then
      CALL S00341(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1413),
     *  C00033,C00144,C00147,C00361,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1415).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00362',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1415).NE.'n') then
      CALL S00342(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1415),
     *  C00033,C00343,C00362,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1417).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00363',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1417).NE.'n') then
      CALL S00343(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1417),
     *  C00033,C00343,C00363,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1419).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00364',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1419).NE.'n') then
      CALL S00344(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1419),
     *  C00033,C00343,C00364,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1421).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00365',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1421).NE.'n') then
      CALL S00345(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1421),
     *  C00033,C00144,C00147,C00365,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1423).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00366',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1423).NE.'n') then
      CALL S00346(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1423),
     *  C00033,C00144,C00147,C00366,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1425).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00367',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1425).NE.'n') then
      CALL S00347(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1425),
     *  C00033,C00343,C00367,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1427).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00368',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1427).NE.'n') then
      CALL S00348(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1427),
     *  C00033,C00343,C00368,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1429).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00369',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1429).NE.'n') then
      CALL S00349(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1429),
     *  C00033,C00343,C00369,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1431).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00370',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1431).NE.'n') then
      CALL S00350(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1431),
     *  C00033,C00144,C00147,C00370,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1433).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00371',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1433).NE.'n') then
      CALL S00351(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1433),
     *  C00033,C00144,C00147,C00371,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1435).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00372',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1435).NE.'n') then
      CALL S00352(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1435),
     *  C00033,C00343,C00372,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1437).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00373',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1437).NE.'n') then
      CALL S00353(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1437),
     *  C00033,C00144,C00147,C00373,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00011')
      RETURN
      END
      SUBROUTINE S00354(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GOVU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      RS1=-C00048(I00001,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00090(I00001,I00002))*C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(3),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GOVU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00354')
      RETURN
      END
      SUBROUTINE S00355(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "GOVU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      RS1=-C00048(I00001,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00090(I00001,I00002)*C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(3),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "GOVU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00355')
      RETURN
      END
      SUBROUTINE S00356(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00233,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00233(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "GOVU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00233(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(3),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "GOVU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00356')
      RETURN
      END
      SUBROUTINE S00361(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00076,C00086,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00003=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*C00086(I00001,I00003)-(-1.0+C00076(I00001))*
     *  (1  -C00090(I00001,I00003))*C00086(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-C00048(I00011,I00003)
      RS2=C00049(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00090(I00011,I00003))*C00086(I00011,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00011))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(8),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00361')
      RETURN
      END
      SUBROUTINE S00362(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00076,C00088,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "GHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00003=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(-1.0+C00076(I00001))*C00090(I00001,I00003)*
     *  C00088(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-C00048(I00011,I00003)
      RS2=C00049(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00090(I00011,I00003)*C00088(I00011,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(8),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "GHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00362')
      RETURN
      END
      SUBROUTINE S00363(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00235,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00235(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "GHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00003=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00235(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(8),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "GHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00363')
      RETURN
      END
      SUBROUTINE S00367(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00242,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00242(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TGCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=C00242(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(9),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TGCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00367')
      RETURN
      END
      SUBROUTINE S00369(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00244,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00244(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TGCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00244(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(9),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TGCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00369')
      RETURN
      END
      SUBROUTINE S00373(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrgc"',
     *  ' in equation "TGCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrgc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       60)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(60),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(9),COLBF(60),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrgc"',
     *  ' in equation "TGCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00373')
      RETURN
      END
      SUBROUTINE S00388(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00058(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(18),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00388')
      RETURN
      END
      SUBROUTINE S00389(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00060(I00001,I00002)*(1.0-C00076(I00001)*
     *  C00099(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(18),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00389')
      RETURN
      END
      SUBROUTINE S00392(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00060,C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-(C00019(I00001,I00002)-C00060(I00001,I00002)*
     *  C00076(I00001)*C00099(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(18),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00392')
      RETURN
      END
      SUBROUTINE S00393(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00265,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00265(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00265(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(18),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00393')
      RETURN
      END
      SUBROUTINE S00397(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrpc"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrpc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       61)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(61),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(18),COLBF(61),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrpc"',
     *  ' in equation "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00397')
      RETURN
      END
      SUBROUTINE S00399(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00097,C00101,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00097(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(1  -C00101(I00001,I00003))*C00097(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(19),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00399')
      RETURN
      END
      SUBROUTINE S00400(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00099,C00101,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00101(I00001,I00003)*C00099(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(19),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00400')
      RETURN
      END
      SUBROUTINE S00401(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00097,C00101,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00097(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(1  -C00101(I00001,I00003))*C00097(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(19),COLBF(13),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00401')
      RETURN
      END
      SUBROUTINE S00402(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00099,C00101,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00101(I00001,I00003)*C00099(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(19),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00402')
      RETURN
      END
      SUBROUTINE S00403(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00098,C00100,C00101,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00098(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00003=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00101(I00001,I00003)*100.0 *C00100(I00001,I00003)-(1  -
     *  C00101(I00001,I00003))*100.0 *C00098(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(19),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00403')
      RETURN
      END
      SUBROUTINE M00012(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GOVU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00354(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00355(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00356(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00233,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(3),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(48),ECHO1,
     *  ROWBF(3),COLBF(48),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(3),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GHHLDDOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(4),ECHO1,
     *  ROWBF(8),COLBF(4),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00361(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00076,C00086,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00362(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00076,C00088,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00363(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00235,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(8),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(8),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TGCRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(4),ECHO1,
     *  ROWBF(9),COLBF(4),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00063,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00367(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00242,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(9),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00243,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00369(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00244,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(9),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00067,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(9),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00245,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(9),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00245,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00373(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(60),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PHHLDINDEX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(50),ECHO1,
     *  ROWBF(10),COLBF(50),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(70),ECHO1,
     *  ROWBF(10),COLBF(70),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00080,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVATEU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(11),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(50),ECHO1,
     *  ROWBF(11),COLBF(50),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(52),ECHO1,
     *  ROWBF(11),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(53),ECHO1,
     *  ROWBF(11),COLBF(53),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00082,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'UTILELASPRIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(12),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00258,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(51),ECHO1,
     *  ROWBF(12),COLBF(51),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(52),ECHO1,
     *  ROWBF(12),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00259,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(70),ECHO1,
     *  ROWBF(12),COLBF(70),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00260,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TPDSHIFT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(13),ECHO1,
     *  ROWBF(14),COLBF(13),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(72),ECHO1,
     *  ROWBF(14),COLBF(72),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TPMSHIFT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(16),ECHO1,
     *  ROWBF(16),COLBF(16),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(72),ECHO1,
     *  ROWBF(16),COLBF(72),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TPCRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00388(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00389(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(12),ECHO1,
     *  ROWBF(18),COLBF(12),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00058,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(13),ECHO1,
     *  ROWBF(18),COLBF(13),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00016,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00392(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00060,C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00393(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00265,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(18),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00062,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(18),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00266,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(52),ECHO1,
     *  ROWBF(18),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00267,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00397(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(61),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(70),ECHO1,
     *  ROWBF(18),COLBF(70),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00268,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PCOMPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00399(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00097,C00101,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00400(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00099,C00101,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00401(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00097,C00101,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00402(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00099,C00101,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00403(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00098,C00100,C00101,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(70),ECHO1,
     *  ROWBF(19),COLBF(70),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00012')
      RETURN
      END
      SUBROUTINE S00405(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00097,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00097(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*C00097(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00405')
      RETURN
      END
      SUBROUTINE S00407(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00097,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00097(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "PHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*C00097(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(13),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "PHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00407')
      RETURN
      END
      SUBROUTINE S00408(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00098,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00098(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00003=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*100.0 *C00098(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00408')
      RETURN
      END
      SUBROUTINE S00409(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "PHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-1.0+C00095(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00003
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "PHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00409')
      RETURN
      END
      SUBROUTINE S00411(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "PHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00003=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 4 I00008=1,SSZ(2)
      ENTRY=-C00096(I00001,I00008,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00008+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    4 CONTINUE
      ENTRY=-C00076(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "PHHLDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00411')
      RETURN
      END
      SUBROUTINE S00412(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "MPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(11)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(22),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "MPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00412')
      RETURN
      END
      SUBROUTINE S00413(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfe"',
     *  ' in equation "MPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       19)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(11)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(11)-1+I00001)+SSZ(6)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(19),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(22),COLBF(19),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfe"',
     *  ' in equation "MPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00413')
      RETURN
      END
      SUBROUTINE S00414(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfe"',
     *  ' in equation "SPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       19)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(6)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(19),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(23),COLBF(19),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pfe"',
     *  ' in equation "SPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00414')
      RETURN
      END
      SUBROUTINE S00416(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00314,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00314(SSZ(11),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(11)
      ENTRY=C00314(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(24),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00416')
      RETURN
      END
      SUBROUTINE S00417(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pmes"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmes',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      DO 2 I00001=1,SSZ(10)
      ENTRY=-C00068(SSMP(SSMPST(10)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(10)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(24),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pmes"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00417')
      RETURN
      END
      SUBROUTINE S00419(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrfu"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrfu',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       63)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(63),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(24),COLBF(63),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrfu"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00419')
      RETURN
      END
      SUBROUTINE S00420(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(7)
      DO 3 I00001=1,SSZ(11)
      ENTRY=-C00068(SSMP(SSMPST(11)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00004=1,SSZ(7)
      DO 5 I00001=1,SSZ(10)
      ENTRY=-C00068(SSMP(SSMPST(10)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(24),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00420')
      RETURN
      END
      SUBROUTINE S00421(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00282,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00282(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=C00282(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(27),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00421')
      RETURN
      END
      SUBROUTINE S00424(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00284,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00284(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00284(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(27),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00424')
      RETURN
      END
      SUBROUTINE S00426(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxriu"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxriu',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(27),COLBF(62),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxriu"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00426')
      RETURN
      END
      SUBROUTINE S00427(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00076,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pft"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pft',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00055(I00001,I00004,I00002)*C00076(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(27),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pft"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00427')
      RETURN
      END
      SUBROUTINE S00428(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00055(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(27),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00428')
      RETURN
      END
      SUBROUTINE S00429(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,C00108,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00104(SSZ(2),SSZ(7),SSZ(1))
      REAL C00108(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "ICOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(1  -C00108(I00001,I00004,I00002))*
     *  C00104(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(28),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "ICOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00429')
      RETURN
      END
      SUBROUTINE S00430(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,C00108,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00108(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "ICOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00108(I00001,I00004,I00002)*C00106(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(28),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "ICOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00430')
      RETURN
      END
      SUBROUTINE S00431(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00105,C00107,C00108,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00105(SSZ(2),SSZ(7),SSZ(1))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL C00108(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "ICOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00108(I00001,I00004,I00002)*100.0 *
     *  C00107(I00001,I00004,I00002)-(1  -C00108(I00001,I00004,I00002))*
     *  100.0 *C00105(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(28),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "ICOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00431')
      RETURN
      END
      SUBROUTINE S00433(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00104(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "INDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*C00104(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(30),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "INDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00433')
      RETURN
      END
      SUBROUTINE S00435(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00105,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00105(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "INDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00003=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*100.0 *C00105(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(30),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "INDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00435')
      RETURN
      END
      SUBROUTINE S00437(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "INDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(30),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "INDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00437')
      RETURN
      END
      SUBROUTINE S00439(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "PFEEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(31),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "PFEEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00439')
      RETURN
      END
      SUBROUTINE S00441(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "PFTEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(32),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "PFTEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00441')
      RETURN
      END
      SUBROUTINE S00442(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00110,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00110(SSZ(18),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "NCOALPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(18)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00008=1,SSZ(18)
      ENTRY=-C00110(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(17)-1+
     *  I00008)))+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(36),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "NCOALPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00442')
      RETURN
      END
      SUBROUTINE S00443(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00110,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00110(SSZ(18),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "NCOALPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(18)
      ENTRY=C00110(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(17)-1+
     *  I00008)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(36),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "NCOALPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00443')
      RETURN
      END
      SUBROUTINE S00446(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00110,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00110(SSZ(18),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "NCOALPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(18)
      ENTRY=C00110(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(17)-1+
     *  I00008)))+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(36),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "NCOALPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00446')
      RETURN
      END
      SUBROUTINE S00447(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00111(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(18)
      RWN=RWN+1
      ENTRY=C00111(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(17)-1+
     *  I00001)))+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      ENTRY=-C00111(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(18)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00447')
      RETURN
      END
      SUBROUTINE S00448(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(18)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(17)-1+
     *  I00001)))+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(18)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00448')
      RETURN
      END
      SUBROUTINE S00449(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00111(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(18)
      RWN=RWN+1
      ENTRY=-(-1.0+C00111(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(17)-1+
     *  I00001)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00449')
      RETURN
      END
      SUBROUTINE S00450(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00111(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afsec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       83)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(18)
      RWN=RWN+1
      ENTRY=-(-1.0+C00111(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),COLBF(83),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00450')
      RETURN
      END
      SUBROUTINE S00451(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00111(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afreg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       84)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(18)
      RWN=RWN+1
      ENTRY=-(-1.0+C00111(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(84),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),COLBF(84),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00451')
      RETURN
      END
      SUBROUTINE S00452(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00111(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(18)
      RWN=RWN+1
      ENTRY=-(-1.0+C00111(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(17)-1+
     *  I00001)))+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "NCOALDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00452')
      RETURN
      END
      SUBROUTINE S00453(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00113,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00113(SSZ(20),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "NELYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(20)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00008=1,SSZ(20)
      ENTRY=-C00113(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(19)-1+I00008)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(38),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "NELYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00453')
      RETURN
      END
      SUBROUTINE S00454(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00113,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00113(SSZ(20),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "NELYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(20)
      ENTRY=C00113(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(19)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(38),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "NELYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00454')
      RETURN
      END
      SUBROUTINE S00457(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00113,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00113(SSZ(20),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "NELYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(20)
      ENTRY=C00113(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(19)-1+I00008)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(38),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "NELYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00457')
      RETURN
      END
      SUBROUTINE M00013(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PHHLDDOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00405(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00097,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(12),ECHO1,
     *  ROWBF(20),COLBF(12),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00407(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00097,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00408(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00098,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00409(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(52),ECHO1,
     *  ROWBF(20),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00095,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00411(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MPFACTPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00412(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00413(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(19),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'SPFACTPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00414(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(19),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(27),ECHO1,
     *  ROWBF(23),COLBF(27),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TFURATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00416(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00314,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00417(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(24),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00069,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00419(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(63),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00420(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TIURATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00421(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00282,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(27),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00283,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(22),ECHO1,
     *  ROWBF(27),COLBF(22),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00053,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00424(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00284,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(27),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00057,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00426(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00427(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00076,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00428(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ICOMPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00429(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,C00108,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00430(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,C00108,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00431(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00105,C00107,C00108,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(75),ECHO1,
     *  ROWBF(28),COLBF(75),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'INDDOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00433(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(22),ECHO1,
     *  ROWBF(30),COLBF(22),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00435(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00105,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(75),ECHO1,
     *  ROWBF(30),COLBF(75),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00076,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00437(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PFEEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(19),ECHO1,
     *  ROWBF(31),COLBF(19),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00439(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PFTEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(75),ECHO1,
     *  ROWBF(32),COLBF(75),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00441(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'NCOALPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00442(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00110,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00443(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00110,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(83),ECHO1,
     *  ROWBF(36),COLBF(83),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00302,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(84),ECHO1,
     *  ROWBF(36),COLBF(84),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00302,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00446(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00110,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'NCOALDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00447(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00448(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00449(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00450(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00451(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(84),KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00452(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00111,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'NELYPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00453(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00113,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00454(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00113,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(83),ECHO1,
     *  ROWBF(38),COLBF(83),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00303,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(84),ECHO1,
     *  ROWBF(38),COLBF(84),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00303,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00457(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00113,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00013')
      RETURN
      END
      SUBROUTINE S00458(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00114(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(20)
      RWN=RWN+1
      ENTRY=C00114(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(19)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      ENTRY=-C00114(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(20)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(39),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00458')
      RETURN
      END
      SUBROUTINE S00459(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(20)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(19)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(20)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(39),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00459')
      RETURN
      END
      SUBROUTINE S00460(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00114(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(20)
      RWN=RWN+1
      ENTRY=-(-1.0+C00114(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(19)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(39),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00460')
      RETURN
      END
      SUBROUTINE S00461(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00114(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afsec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       83)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(20)
      RWN=RWN+1
      ENTRY=-(-1.0+C00114(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(39),COLBF(83),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00461')
      RETURN
      END
      SUBROUTINE S00462(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00114(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afreg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       84)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(20)
      RWN=RWN+1
      ENTRY=-(-1.0+C00114(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(84),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(39),COLBF(84),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00462')
      RETURN
      END
      SUBROUTINE S00463(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00114(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(20)
      RWN=RWN+1
      ENTRY=-(-1.0+C00114(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(19)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(39),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "NELYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00463')
      RETURN
      END
      SUBROUTINE S00464(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00116(SSZ(22),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "ENYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00008=1,SSZ(22)
      ENTRY=-C00116(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(21)-1+I00008)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(40),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "ENYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00464')
      RETURN
      END
      SUBROUTINE S00465(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00116(SSZ(22),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "ENYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(22)
      ENTRY=C00116(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(21)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(40),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "ENYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00465')
      RETURN
      END
      SUBROUTINE S00468(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00116(SSZ(22),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "ENYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(22)
      ENTRY=C00116(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(21)-1+I00008)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(40),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "ENYPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00468')
      RETURN
      END
      SUBROUTINE S00469(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00117,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00117(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(22)
      RWN=RWN+1
      ENTRY=C00117(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(21)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      ENTRY=-C00117(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00469')
      RETURN
      END
      SUBROUTINE S00470(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(22)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(21)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00470')
      RETURN
      END
      SUBROUTINE S00471(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00117,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00117(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(22)
      RWN=RWN+1
      ENTRY=-(-1.0+C00117(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(21)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00471')
      RETURN
      END
      SUBROUTINE S00472(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00117,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00117(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afsec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       83)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(22)
      RWN=RWN+1
      ENTRY=-(-1.0+C00117(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),COLBF(83),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00472')
      RETURN
      END
      SUBROUTINE S00473(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00117,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00117(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afreg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       84)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(22)
      RWN=RWN+1
      ENTRY=-(-1.0+C00117(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(84),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),COLBF(84),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00473')
      RETURN
      END
      SUBROUTINE S00474(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00117,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00117(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(22)
      RWN=RWN+1
      ENTRY=-(-1.0+C00117(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(21)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "ENYDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00474')
      RETURN
      END
      SUBROUTINE S00475(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00119,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00119(SSZ(24),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "CAPENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(24)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00008=1,SSZ(24)
      ENTRY=-C00119(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00008)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(42),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "CAPENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00475')
      RETURN
      END
      SUBROUTINE S00476(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00119,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00119(SSZ(24),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "CAPENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(24)
      ENTRY=C00119(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(42),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "CAPENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00476')
      RETURN
      END
      SUBROUTINE S00479(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00119,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00119(SSZ(24),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "CAPENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(24)
      ENTRY=C00119(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00008)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(42),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "CAPENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00479')
      RETURN
      END
      SUBROUTINE S00480(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00120,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00120(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=C00120(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      ENTRY=-C00120(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(24)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(43),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00480')
      RETURN
      END
      SUBROUTINE S00481(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(24)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(43),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00481')
      RETURN
      END
      SUBROUTINE S00482(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00120,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00120(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=-(-1.0+C00120(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(43),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00482')
      RETURN
      END
      SUBROUTINE S00483(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00120,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00120(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afsec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       83)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=-(-1.0+C00120(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(43),COLBF(83),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00483')
      RETURN
      END
      SUBROUTINE S00484(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00120,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00120(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afreg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       84)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=-(-1.0+C00120(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(84),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(43),COLBF(84),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00484')
      RETURN
      END
      SUBROUTINE S00485(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00120,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00120(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=-(-1.0+C00120(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(43),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "CAPENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00485')
      RETURN
      END
      SUBROUTINE S00486(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00122(SSZ(26),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "VAENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00008=1,SSZ(26)
      ENTRY=-C00122(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00008)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(44),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "VAENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00486')
      RETURN
      END
      SUBROUTINE S00487(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00122(SSZ(26),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "VAENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(26)
      ENTRY=C00122(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(44),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "VAENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00487')
      RETURN
      END
      SUBROUTINE S00490(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00122(SSZ(26),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "VAENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(26)
      ENTRY=C00122(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00008)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(44),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "VAENPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00490')
      RETURN
      END
      SUBROUTINE S00491(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00123(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(26)
      RWN=RWN+1
      ENTRY=C00123(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      ENTRY=-C00123(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(45),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00491')
      RETURN
      END
      SUBROUTINE S00492(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(26)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+1)+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(45),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00492')
      RETURN
      END
      SUBROUTINE S00493(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00123(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(26)
      RWN=RWN+1
      ENTRY=-(-1.0+C00123(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(45),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00493')
      RETURN
      END
      SUBROUTINE S00494(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00123(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afsec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       83)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(26)
      RWN=RWN+1
      ENTRY=-(-1.0+C00123(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(45),COLBF(83),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00494')
      RETURN
      END
      SUBROUTINE S00495(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00123(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afreg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       84)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(26)
      RWN=RWN+1
      ENTRY=-(-1.0+C00123(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(84),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(45),COLBF(84),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00495')
      RETURN
      END
      SUBROUTINE S00496(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00123(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(26)
      RWN=RWN+1
      ENTRY=-(-1.0+C00123(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(45),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "VAENDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00496')
      RETURN
      END
      SUBROUTINE S00497(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00004)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00497')
      RETURN
      END
      SUBROUTINE S00498(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00127,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00127(SSZ(28),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(28)
      ENTRY=-C00127(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00498')
      RETURN
      END
      SUBROUTINE S00499(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00127,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00127(SSZ(28),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(28)
      ENTRY=C00127(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00499')
      RETURN
      END
      SUBROUTINE S00502(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00127,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00127(SSZ(28),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(28)
      ENTRY=C00127(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00502')
      RETURN
      END
      SUBROUTINE S00507(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00124(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-C00124(I00004)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00004)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00507')
      RETURN
      END
      SUBROUTINE S00508(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00004)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00508')
      RETURN
      END
      SUBROUTINE S00509(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00124(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       77)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=C00124(I00004)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(77),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(77),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00509')
      RETURN
      END
      SUBROUTINE S00510(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00510')
      RETURN
      END
      SUBROUTINE S00511(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00124(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afcom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-(-1.0+C00124(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00511')
      RETURN
      END
      SUBROUTINE S00512(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00124(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afsec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       83)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-(-1.0+C00124(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(83),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00512')
      RETURN
      END
      SUBROUTINE S00513(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00124(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afreg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       84)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-(-1.0+C00124(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(84),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(84),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00513')
      RETURN
      END
      SUBROUTINE S00514(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00124(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-(-1.0+C00124(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(17)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00514')
      RETURN
      END
      SUBROUTINE S00515(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00124(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aosec"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'aosec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       87)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-(-1.0+C00124(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "aosec"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00515')
      RETURN
      END
      SUBROUTINE S00516(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00124(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aoreg"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'aoreg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       88)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-(-1.0+C00124(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(88),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(88),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "aoreg"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00516')
      RETURN
      END
      SUBROUTINE S00517(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00124(SSZ(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aoall"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'aoall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       89)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-(-1.0+C00124(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(7)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(89),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(89),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "aoall"',
     *  ' in equation "TOPDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00517')
      RETURN
      END
      SUBROUTINE M00014(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'NELYDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00458(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00459(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00460(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00461(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00462(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(84),KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00463(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ENYPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00464(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00465(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(83),ECHO1,
     *  ROWBF(40),COLBF(83),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00304,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(84),ECHO1,
     *  ROWBF(40),COLBF(84),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00304,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00468(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ENYDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00469(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00117,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00470(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00471(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00117,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00472(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00117,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00473(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(84),KZC,DOEQ,STRHS,STRHNZ,
     *  C00117,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00474(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00117,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CAPENPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00475(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00119,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00476(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00119,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(83),ECHO1,
     *  ROWBF(42),COLBF(83),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00305,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(84),ECHO1,
     *  ROWBF(42),COLBF(84),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00305,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00479(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00119,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CAPENDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00480(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00120,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00481(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00482(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00120,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00483(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00120,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00484(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(84),KZC,DOEQ,STRHS,STRHNZ,
     *  C00120,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00485(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00120,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VAENPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00486(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00487(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(83),ECHO1,
     *  ROWBF(44),COLBF(83),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00306,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(84),ECHO1,
     *  ROWBF(44),COLBF(84),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00306,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00490(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00122,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VAENDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00491(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00492(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00493(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00494(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00495(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(84),KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00496(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ZEROPROFITS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00497(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00498(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00127,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00499(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00127,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(83),ECHO1,
     *  ROWBF(47),COLBF(83),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00307,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(84),ECHO1,
     *  ROWBF(47),COLBF(84),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00307,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00502(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00127,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(87),ECHO1,
     *  ROWBF(47),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(88),ECHO1,
     *  ROWBF(47),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(47),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(90),ECHO1,
     *  ROWBF(47),COLBF(90),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOPDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00507(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00508(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00509(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(77),KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00510(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00511(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00512(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00513(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(84),KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00514(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00515(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00516(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00517(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00124,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00014')
      RETURN
      END
      SUBROUTINE S00518(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00518')
      RETURN
      END
      SUBROUTINE S00519(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00519')
      RETURN
      END
      SUBROUTINE S00520(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       54)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(54),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),COLBF(54),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00520')
      RETURN
      END
      SUBROUTINE S00521(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-C00070(SSMP(SSMPST(9)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(50),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00521')
      RETURN
      END
      SUBROUTINE S00522(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-C00070(SSMP(SSMPST(9)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(50),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00522')
      RETURN
      END
      SUBROUTINE S00524(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       54)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=C00045(SSMP(SSMPST(9)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(54),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(50),COLBF(54),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00524')
      RETURN
      END
      SUBROUTINE S00525(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrout"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrout',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       64)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(64),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(50),COLBF(64),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrout"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00525')
      RETURN
      END
      SUBROUTINE S00526(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00007
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "KAPSVCES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00008=1,SSZ(12)
      RS1=RS1+C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00008))),I00002)
    2 CONTINUE
      DO 3 I00007=1,SSZ(12)
      RS2=-C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007))),I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      ENTRY=RS4
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(51),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "KAPSVCES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00526')
      RETURN
      END
      SUBROUTINE S00528(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00007
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "KAPRENTAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00008=1,SSZ(12)
      RS1=RS1+C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00008))),I00002)
    2 CONTINUE
      DO 3 I00007=1,SSZ(12)
      RS2=-C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007))),I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      ENTRY=RS4
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(52),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "KAPRENTAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00528')
      RETURN
      END
      SUBROUTINE S00530(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00077,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00007
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00077(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CAPGOODS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00007=1,SSZ(5)
      RS1=-C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)
      RS2=C00077(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(53),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CAPGOODS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00530')
      RETURN
      END
      SUBROUTINE S00532(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00077,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00007
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00077(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "PRCGOODS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00007=1,SSZ(5)
      RS1=-C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)
      RS2=C00077(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(54),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "PRCGOODS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00532')
      RETURN
      END
      SUBROUTINE S00536(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00129(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "KEND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-(1.0-C00129(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(56),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "KEND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00536')
      RETURN
      END
      SUBROUTINE S00546(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "BALDWIN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(12)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(59),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "BALDWIN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00546')
      RETURN
      END
      SUBROUTINE S00549(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00078,C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00078(SSZ(1))
      INTEGER C00132(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=-(1  -C00132(1))*C00031(I00002)
      RS2=C00078(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(60),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00549')
      RETURN
      END
      SUBROUTINE S00550(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00132(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "globalcgds"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'globalcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       56)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-(1  -C00132(1))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(56),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(60),COLBF(56),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "globalcgds"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00550')
      RETURN
      END
      SUBROUTINE S00551(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00132(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rore"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'rore',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       93)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00132(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(93),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(60),COLBF(93),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "rore"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00551')
      RETURN
      END
      SUBROUTINE S00552(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00077,C00078,C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00077(SSZ(1))
      REAL C00078(SSZ(1))
      INTEGER C00132(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qcgds"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       95)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=(1  -C00132(1))*C00077(I00002)
      RS2=C00078(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(95),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(60),COLBF(95),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qcgds"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00552')
      RETURN
      END
      SUBROUTINE S00553(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00132(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rorg"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'rorg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       98)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00132(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(98),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(60),COLBF(98),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "rorg"',
     *  ' in equation "RORGLOBAL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00553')
      RETURN
      END
      SUBROUTINE S00555(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00079,C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00079(1)
      INTEGER C00132(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=C00132(1)*C00031(I00002)
      RS2=C00079(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00555')
      RETURN
      END
      SUBROUTINE S00556(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00132(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "globalcgds"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'globalcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       56)
      RWN=RWN+1
      ENTRY=C00132(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(56),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),COLBF(56),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "globalcgds"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00556')
      RETURN
      END
      SUBROUTINE S00557(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00079,C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00079(1)
      INTEGER C00132(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rore"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'rore',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       93)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=-(1  -C00132(1))*C00078(I00002)
      RS2=C00079(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(93),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),COLBF(93),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "rore"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00557')
      RETURN
      END
      SUBROUTINE S00558(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00077,C00079,C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00077(SSZ(1))
      REAL C00079(1)
      INTEGER C00132(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qcgds"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       95)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=-C00132(1)*C00077(I00002)
      RS2=C00079(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(95),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),COLBF(95),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qcgds"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00558')
      RETURN
      END
      SUBROUTINE S00559(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00132(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rorg"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'rorg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       98)
      RWN=RWN+1
      ENTRY=1  -C00132(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(98),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),COLBF(98),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "rorg"',
     *  ' in equation "GLOBALINV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00559')
      RETURN
      END
      SUBROUTINE S00560(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00079,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00079(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "PRICGDS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       29)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=-C00078(I00002)
      RS2=C00079(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(62),COLBF(29),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "PRICGDS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00560')
      RETURN
      END
      SUBROUTINE S00563(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00078,C00079,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00078(SSZ(1))
      REAL C00079(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "SAVEPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       29)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 3 I00003=1,SSZ(1)
      RS1=-(C00078(I00003)-C00009(I00003))
      RS2=C00079(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00003
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(63),COLBF(29),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "SAVEPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00563')
      RETURN
      END
      SUBROUTINE S00565(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00318,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00318(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TEXPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=C00318(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(65),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TEXPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00565')
      RETURN
      END
      SUBROUTINE S00568(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrexp"',
     *  ' in equation "TEXPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrexp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(65),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrexp"',
     *  ' in equation "TEXPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00568')
      RETURN
      END
      SUBROUTINE S00570(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00035,C00072,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "TEXPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-(-C00035(I00001,I00002,I00003)-
     *  C00072(I00001,I00002,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(65),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "TEXPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00570')
      RETURN
      END
      SUBROUTINE M00015(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'OUTPUTPRICES',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00518(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00519(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00520(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(54),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOUTRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00521(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00522(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(50),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00071,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00524(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(54),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00525(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(64),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'KAPSVCES',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00526(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(96),ECHO1,
     *  ROWBF(51),COLBF(96),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'KAPRENTAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00528(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(91),ECHO1,
     *  ROWBF(52),COLBF(91),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CAPGOODS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00530(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00077,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(95),ECHO1,
     *  ROWBF(53),COLBF(95),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRCGOODS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00532(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00077,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(29),ECHO1,
     *  ROWBF(54),COLBF(29),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'KBEGINNING',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(28),ECHO1,
     *  ROWBF(55),COLBF(28),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(96),ECHO1,
     *  ROWBF(55),COLBF(96),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'KEND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00536(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(92),ECHO1,
     *  ROWBF(56),COLBF(92),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(95),ECHO1,
     *  ROWBF(56),COLBF(95),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00129,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'RORCURRENT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(29),ECHO1,
     *  ROWBF(57),COLBF(29),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00130,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(91),ECHO1,
     *  ROWBF(57),COLBF(91),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00130,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(94),ECHO1,
     *  ROWBF(57),COLBF(94),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ROREXPECTED',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(28),ECHO1,
     *  ROWBF(58),COLBF(28),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00131,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(92),ECHO1,
     *  ROWBF(58),COLBF(92),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00131,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(93),ECHO1,
     *  ROWBF(58),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(94),ECHO1,
     *  ROWBF(58),COLBF(94),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'BALDWIN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00546(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(95),ECHO1,
     *  ROWBF(59),COLBF(95),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(97),ECHO1,
     *  ROWBF(59),COLBF(97),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'RORGLOBAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00549(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00078,C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00550(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(56),KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00551(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(93),KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00552(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(95),KZC,DOEQ,STRHS,STRHNZ,
     *  C00077,C00078,C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00553(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(98),KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(99),ECHO1,
     *  ROWBF(60),COLBF(99),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GLOBALINV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00555(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00079,C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00556(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(56),KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00557(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(93),KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00079,C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00558(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(95),KZC,DOEQ,STRHS,STRHNZ,
     *  C00077,C00079,C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00559(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(98),KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRICGDS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00560(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(29),KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00079,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(57),ECHO1,
     *  ROWBF(62),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'SAVEPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(1),ECHO1,
     *  ROWBF(63),COLBF(1),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00563(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(29),KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00078,C00079,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(100),ECHO1,
     *  ROWBF(63),COLBF(100),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TEXPRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00565(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00318,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(31),ECHO1,
     *  ROWBF(65),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00072,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(65),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00073,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00568(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(101),ECHO1,
     *  ROWBF(65),COLBF(101),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00319,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00570(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00035,C00072,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00015')
      RETURN
      END
      SUBROUTINE S00571(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00133,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00133(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "DPRICEIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(1)
      ENTRY=-C00133(I00001,I00008,I00003)*C00146(I00001,I00008,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00008-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(67),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "DPRICEIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00571')
      RETURN
      END
      SUBROUTINE S00574(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00133,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00133(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "DPRICEIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(1)
      ENTRY=C00133(I00001,I00008,I00003)*C00146(I00001,I00008,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00008-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(67),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "DPRICEIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00574')
      RETURN
      END
      SUBROUTINE S00575(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00133,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00133(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "DPRICEIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(1)
      ENTRY=C00133(I00001,I00008,I00003)*C00146(I00001,I00008,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00008-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(67),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "DPRICEIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00575')
      RETURN
      END
      SUBROUTINE S00578(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00352,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00352(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "DPRICEIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(3)
      ENTRY=C00352(I00005,I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(67),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "DPRICEIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00578')
      RETURN
      END
      SUBROUTINE S00580(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00133,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00133(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ats"',
     *  ' in equation "DPRICEIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ats',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(1)
      ENTRY=C00133(I00001,I00008,I00003)*C00343(I00001,I00008,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00008
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(110),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(67),COLBF(110),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ats"',
     *  ' in equation "DPRICEIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00580')
      RETURN
      END
      SUBROUTINE S00583(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PRICETGT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(68),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PRICETGT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00583')
      RETURN
      END
      SUBROUTINE S00586(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(2))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00134(I00001)*C00146(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00586')
      RETURN
      END
      SUBROUTINE S00590(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ams',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       80)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(-1.0+C00134(I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(80),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(80),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00590')
      RETURN
      END
      SUBROUTINE S00591(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(2))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00134(I00001)*C00146(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00591')
      RETURN
      END
      SUBROUTINE S00592(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(2))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00134(I00001)*C00146(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00592')
      RETURN
      END
      SUBROUTINE S00595(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00144,C00147,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(2))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 4 I00005=1,SSZ(3)
      ENTRY=-C00134(I00001)*C00147(I00001,I00002,I00003)*
     *  C00144(I00005,I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00595')
      RETURN
      END
      SUBROUTINE S00596(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(2))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atf"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00134(I00001)*C00343(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(109),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(109),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atf"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00596')
      RETURN
      END
      SUBROUTINE S00597(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(2))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ats"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ats',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00134(I00001)*C00343(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(110),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(110),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ats"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00597')
      RETURN
      END
      SUBROUTINE S00598(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(2))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atd"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00134(I00001)*C00343(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00003
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(111),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(111),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atd"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00598')
      RETURN
      END
      SUBROUTINE S00599(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00144,C00147,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(2))
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pt"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pt',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      115)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 4 I00005=1,SSZ(3)
      ENTRY=C00134(I00001)*C00147(I00001,I00002,I00003)*
     *  C00144(I00005,I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(115),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(115),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pt"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00599')
      RETURN
      END
      SUBROUTINE S00600(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00074(I00001,I00003,I00002)*C00146(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(70),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00600')
      RETURN
      END
      SUBROUTINE S00603(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrimp"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrimp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       66)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(66),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(70),COLBF(66),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrimp"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00603')
      RETURN
      END
      SUBROUTINE S00604(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=C00074(I00001,I00003,I00002)*C00146(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(70),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00604')
      RETURN
      END
      SUBROUTINE S00605(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=C00074(I00001,I00003,I00002)*C00146(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(70),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00605')
      RETURN
      END
      SUBROUTINE S00608(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00356,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00356(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(3)
      ENTRY=C00356(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(70),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00608')
      RETURN
      END
      SUBROUTINE S00614(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00339,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00339(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "TRANS_DEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00339(I00005)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(72),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "TRANS_DEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00614')
      RETURN
      END
      SUBROUTINE S00619(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00142,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00142(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PTRANSPORT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00005=1,SSZ(3)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      ENTRY=-C00142(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(73),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PTRANSPORT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00619')
      RETURN
      END
      SUBROUTINE M00016(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DPRICEIMP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00571(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00133,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(67),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(80),ECHO1,
     *  ROWBF(67),COLBF(80),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00133,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00574(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00133,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00575(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00133,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(103),ECHO1,
     *  ROWBF(67),COLBF(103),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00338,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(104),ECHO1,
     *  ROWBF(67),COLBF(104),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00133,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00578(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00352,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(67),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00353,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00580(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00133,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(67),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00353,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(67),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),SSZ(1),1,1,1,1,C00354,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRICETGT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00583(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(68),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(105),ECHO1,
     *  ROWBF(68),COLBF(105),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'IMPORTDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00586(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(69),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00134,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(31),ECHO1,
     *  ROWBF(69),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(55),ECHO1,
     *  ROWBF(69),COLBF(55),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00590(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(80),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00591(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00592(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(103),ECHO1,
     *  ROWBF(69),COLBF(103),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00134,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(104),ECHO1,
     *  ROWBF(69),COLBF(104),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00134,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00595(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00144,C00147,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00596(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00597(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00598(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00599(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(115),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,C00144,C00147,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TIMPRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00600(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(31),ECHO1,
     *  ROWBF(70),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00074,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(70),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00075,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00603(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(66),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00604(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00605(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(103),ECHO1,
     *  ROWBF(70),COLBF(103),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00355,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(104),ECHO1,
     *  ROWBF(70),COLBF(104),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00032,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00608(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00356,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(70),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00357,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(110),ECHO1,
     *  ROWBF(70),COLBF(110),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),SSZ(1),1,1,1,1,1,C00358,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(70),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00359,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(70),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00360,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TRANS_DEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(31),ECHO1,
     *  ROWBF(72),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),SSZ(1),SSZ(1),1,1,1,C00141,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00614(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00339,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(72),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),1,1,1,1,1,C00340,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(110),ECHO1,
     *  ROWBF(72),COLBF(110),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00341,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(72),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00342,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(114),ECHO1,
     *  ROWBF(72),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PTRANSPORT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00619(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00142,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(73),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00016')
      RETURN
      END
      SUBROUTINE S00621(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TRANSVCES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(76),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TRANSVCES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00621')
      RETURN
      END
      SUBROUTINE S00628(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00084,C00148,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00084(SSZ(1))
      REAL C00148(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "EMTRADING"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-(C00148(I00002)-C00084(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "EMTRADING"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00628')
      RETURN
      END
      SUBROUTINE S00629(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00084(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2t"',
     *  ' in equation "EMTRADING"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2t',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       58)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00084(I00002)*C00043(I00002)*0.01
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(58),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(58),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2t"',
     *  ' in equation "EMTRADING"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00629')
      RETURN
      END
      SUBROUTINE S00631(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00148,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00148(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2q"',
     *  ' in equation "EMTRADING"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2q',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      116)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00148(I00002)*C00043(I00002)*0.01
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(116),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(116),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2q"',
     *  ' in equation "EMTRADING"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00631')
      RETURN
      END
      SUBROUTINE S00632(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00006
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL LG1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00084(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2t"',
     *  ' in equation "TOTALEMISSIONSB"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2t',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       58)
      DO     1 I00006=1,SSZ(15)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      RS1=0.0
      LG1=C00008(I00002).EQ.I00006
      IF(LG1) THEN
      RS1=-C00084(I00002)
      END IF
      ENTRY=RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(58),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(80),COLBF(58),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2t"',
     *  ' in equation "TOTALEMISSIONSB"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00632')
      RETURN
      END
      SUBROUTINE S00634(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00148,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00006
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL LG1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00148(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2q"',
     *  ' in equation "EMISSQUOTA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2q',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      116)
      DO     1 I00006=1,SSZ(15)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      RS1=0.0
      LG1=C00008(I00002).EQ.I00006
      IF(LG1) THEN
      RS1=-C00148(I00002)
      END IF
      ENTRY=RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(116),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(81),COLBF(116),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2q"',
     *  ' in equation "EMISSQUOTA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00634')
      RETURN
      END
      SUBROUTINE S00639(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(83),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00639')
      RETURN
      END
      SUBROUTINE S00640(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(83),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00640')
      RETURN
      END
      SUBROUTINE S00641(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       54)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(54),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(83),COLBF(54),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00641')
      RETURN
      END
      SUBROUTINE S00642(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-C00070(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(84),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00642')
      RETURN
      END
      SUBROUTINE S00643(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-C00070(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(84),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00643')
      RETURN
      END
      SUBROUTINE S00645(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       54)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(54),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(84),COLBF(54),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00645')
      RETURN
      END
      SUBROUTINE S00646(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_taxrinc"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       67)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(67),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(84),COLBF(67),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_taxrinc"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00646')
      RETURN
      END
      SUBROUTINE S00647(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "ENDW_PRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(85),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "ENDW_PRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00647')
      RETURN
      END
      SUBROUTINE S00648(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00155,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00155(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pmes"',
     *  ' in equation "ENDW_PRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmes',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(10)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(7)
      ENTRY=-C00155(SSMP(SSMPST(10)-1+I00001),I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(10)*(I00008-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(85),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pmes"',
     *  ' in equation "ENDW_PRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00648')
      RETURN
      END
      SUBROUTINE S00649(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00156,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00156(SSZ(6))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=-C00156(SSMP(SSMPST(10)-1+I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(86),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00649')
      RETURN
      END
      SUBROUTINE S00650(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(86),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00650')
      RETURN
      END
      SUBROUTINE S00651(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00156,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00156(SSZ(6))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pmes"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmes',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=C00156(SSMP(SSMPST(10)-1+I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(10)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(86),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pmes"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00651')
      RETURN
      END
      SUBROUTINE S00653(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "endwslack"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'endwslack',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       46)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(6)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(46),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(86),COLBF(46),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "endwslack"',
     *  ' in equation "ENDW_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00653')
      RETURN
      END
      SUBROUTINE S00656(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*C00099(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(88),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00656')
      RETURN
      END
      SUBROUTINE S00657(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "PIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*C00099(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(88),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "PIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00657')
      RETURN
      END
      SUBROUTINE S00659(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00100,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*100.0 *C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(88),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00659')
      RETURN
      END
      SUBROUTINE S00660(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "PIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-1.0+C00095(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(88),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "PIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00660')
      RETURN
      END
      SUBROUTINE S00662(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "PIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 4 I00008=1,SSZ(2)
      ENTRY=-C00096(I00001,I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00008+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    4 CONTINUE
      ENTRY=-C00076(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(88),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "PIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00662')
      RETURN
      END
      SUBROUTINE S00665(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00076,C00086,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(-1.0+C00076(I00001))*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-C00048(I00011,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00090(I00011,I00002))*C00086(I00011,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00011))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(90),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00665')
      RETURN
      END
      SUBROUTINE S00666(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00076,C00088,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "GIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*C00088(I00001,I00002)-(-1.0+C00076(I00001))*
     *  C00090(I00001,I00002)*C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-C00048(I00011,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00090(I00011,I00002)*C00088(I00011,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(90),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "GIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00666')
      RETURN
      END
      SUBROUTINE S00668(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00234,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00234(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "GIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00234(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(90),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "GIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00668')
      RETURN
      END
      SUBROUTINE M00017(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TRANSVCES',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00621(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(76),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(114),ECHO1,
     *  ROWBF(76),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(76),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PEMPURCH',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(58),ECHO1,
     *  ROWBF(78),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(116),ECHO1,
     *  ROWBF(78),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(117),ECHO1,
     *  ROWBF(78),COLBF(117),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EMTRADING',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00628(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00084,C00148,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00629(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(58),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(59),ECHO1,
     *  ROWBF(79),COLBF(59),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00631(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(116),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00148,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOTALEMISSIONSB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00632(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(58),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(118),ECHO1,
     *  ROWBF(80),COLBF(118),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(15),1,1,1,1,1,1,C00085,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EMISSQUOTA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00634(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(116),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00148,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(119),ECHO1,
     *  ROWBF(81),COLBF(119),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(15),1,1,1,1,1,1,C00149,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PEMPURCHB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(118),ECHO1,
     *  ROWBF(82),COLBF(118),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(119),ECHO1,
     *  ROWBF(82),COLBF(119),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(120),ECHO1,
     *  ROWBF(82),COLBF(120),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'FACTORINCPRICES',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00639(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00640(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00641(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(54),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TINCRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00642(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00643(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(84),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00154,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00645(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(54),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00646(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(67),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ENDW_PRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00647(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00648(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00155,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ENDW_SUPPLY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00649(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00156,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00650(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00651(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00156,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(45),ECHO1,
     *  ROWBF(86),COLBF(45),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00653(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(46),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PDEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(12),ECHO1,
     *  ROWBF(87),COLBF(12),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(39),ECHO1,
     *  ROWBF(87),COLBF(39),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PIEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00656(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00657(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(40),ECHO1,
     *  ROWBF(88),COLBF(40),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00659(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00100,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00660(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(52),ECHO1,
     *  ROWBF(88),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00095,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00662(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GDEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(4),ECHO1,
     *  ROWBF(89),COLBF(4),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(37),ECHO1,
     *  ROWBF(89),COLBF(37),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GIEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00665(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00076,C00086,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00666(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00076,C00088,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(38),ECHO1,
     *  ROWBF(90),COLBF(38),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00668(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00234,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(90),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(90),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00017')
      RETURN
      END
      SUBROUTINE S00673(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00106,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "FIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*C00106(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(92),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "FIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00673')
      RETURN
      END
      SUBROUTINE S00675(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00107,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "FIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(7)
      DO     4 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00076(I00001)*100.0 *C00107(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(92),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "FIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00675')
      RETURN
      END
      SUBROUTINE S00677(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "FIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(92),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "FIEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00677')
      RETURN
      END
      SUBROUTINE S00678(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00037,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00037(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2fd"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2fd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       35)
      DO     1 I00001=1,SSZ(14)
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-C00037(SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+
     *  I00001)),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001))+SSZ(2)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(35),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(35),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2fd"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00678')
      RETURN
      END
      SUBROUTINE S00679(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00038,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00038(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2fm"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2fm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       36)
      DO     1 I00001=1,SSZ(14)
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-C00038(SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+
     *  I00001)),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001))+SSZ(2)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(36),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(36),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2fm"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00679')
      RETURN
      END
      SUBROUTINE S00680(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00039,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00039(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2gd"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2gd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       37)
      DO     1 I00001=1,SSZ(14)
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00039(SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001))+SSZ(2)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(37),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(37),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2gd"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00680')
      RETURN
      END
      SUBROUTINE S00681(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00040,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00040(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2gm"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2gm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       38)
      DO     1 I00001=1,SSZ(14)
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00040(SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001))+SSZ(2)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(38),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(38),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2gm"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00681')
      RETURN
      END
      SUBROUTINE S00682(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00041,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00041(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2pd"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2pd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       39)
      DO     1 I00001=1,SSZ(14)
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00041(SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001))+SSZ(2)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(39),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(39),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2pd"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00682')
      RETURN
      END
      SUBROUTINE S00683(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00042,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00042(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2pm"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       40)
      DO     1 I00001=1,SSZ(14)
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00042(SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001))+SSZ(2)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(40),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(40),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2pm"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00683')
      RETURN
      END
      SUBROUTINE S00684(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00083,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00083(SSZ(1),SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      121)
      DO     1 I00001=1,SSZ(14)
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00083(I00002,SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002+SSZ(1)*(I00001-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(121),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(93),COLBF(121),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2"',
     *  ' in equation "CEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00684')
      RETURN
      END
      SUBROUTINE S00686(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00083,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00083(SSZ(1),SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2"',
     *  ' in equation "TOTALEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      121)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(14)
      ENTRY=-C00083(I00002,SSMP(SSMPST(13)-1+SSMP(SSMPST(14)-1+I00001)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002+SSZ(1)*(I00001-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(121),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(94),COLBF(121),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2"',
     *  ' in equation "TOTALEMISSIONS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00686')
      RETURN
      END
      SUBROUTINE S00688(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00084(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2tw"',
     *  ' in equation "WORLDEMISS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2tw',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      127)
      RWN=RWN+1
      RS1=0.0
      DO 1 I00002=1,SSZ(1)
      RS1=RS1+C00084(I00002)
    1 CONTINUE
      ENTRY=RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(127),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(95),COLBF(127),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "gco2tw"',
     *  ' in equation "WORLDEMISS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00688')
      RETURN
      END
      SUBROUTINE S00689(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00157,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00157(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "REALTAXCH"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=-1.0
      RS2=C00157(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(96),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "REALTAXCH"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00689')
      RETURN
      END
      SUBROUTINE S00690(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00157,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00157(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "p"',
     *  ' in equation "REALTAXCH"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'p',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       43)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=1.0
      RS2=C00157(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*0.01  *C00043(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(43),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(96),COLBF(43),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "p"',
     *  ' in equation "REALTAXCH"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00690')
      RETURN
      END
      SUBROUTINE S00692(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00006
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL LG1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "p"',
     *  ' in equation "PIND_b"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'p',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       43)
      DO     1 I00006=1,SSZ(15)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      RS1=0.0
      LG1=C00008(I00002).EQ.I00006
      IF(LG1) THEN
      RS1=-C00052(I00002)
      END IF
      ENTRY=RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(43),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(97),COLBF(43),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "p"',
     *  ' in equation "PIND_b"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00692')
      RETURN
      END
      SUBROUTINE S00694(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00006
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00159(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "REALTAXCHB"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I00006=1,SSZ(15)
      RWN=RWN+1
      RS1=-1.0
      RS2=C00159(I00006)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00006
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(98),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "REALTAXCHB"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00694')
      RETURN
      END
      SUBROUTINE S00695(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,C00160,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00006
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00159(SSZ(15))
      REAL C00160(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pb"',
     *  ' in equation "REALTAXCHB"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      129)
      DO     1 I00006=1,SSZ(15)
      RWN=RWN+1
      RS1=1.0
      RS2=C00159(I00006)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*0.01  *C00160(I00006)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00006
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(129),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(98),COLBF(129),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pb"',
     *  ' in equation "REALTAXCHB"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00695')
      RETURN
      END
      SUBROUTINE S00699(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "E_TAXLEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(100),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "E_TAXLEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00699')
      RETURN
      END
      SUBROUTINE S00702(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00162,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00161(SSZ(1),SSZ(14))
      REAL C00162(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "p_CO2_L"',
     *  ' in equation "VALCTAX"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'p_CO2_L',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      131)
      DO     1 I00001=1,SSZ(14)
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00162(I00002)*C00161(I00002,I00001)/100.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002+SSZ(1)*(I00001-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(131),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(101),COLBF(131),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "p_CO2_L"',
     *  ' in equation "VALCTAX"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00702')
      RETURN
      END
      SUBROUTINE S00704(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(102),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00704')
      RETURN
      END
      SUBROUTINE S00705(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "FACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(102),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "FACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00705')
      RETURN
      END
      SUBROUTINE M00018(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'FDEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(22),ECHO1,
     *  ROWBF(91),COLBF(22),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(35),ECHO1,
     *  ROWBF(91),COLBF(35),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'FIEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00673(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00106,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(36),ECHO1,
     *  ROWBF(92),COLBF(36),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00675(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00107,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(75),ECHO1,
     *  ROWBF(92),COLBF(75),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00076,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00677(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00678(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(35),KZC,DOEQ,STRHS,STRHNZ,
     *  C00037,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00679(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(36),KZC,DOEQ,STRHS,STRHNZ,
     *  C00038,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00680(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(37),KZC,DOEQ,STRHS,STRHNZ,
     *  C00039,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00681(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(38),KZC,DOEQ,STRHS,STRHNZ,
     *  C00040,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00682(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(39),KZC,DOEQ,STRHS,STRHNZ,
     *  C00041,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00683(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(40),KZC,DOEQ,STRHS,STRHNZ,
     *  C00042,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00684(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(121),KZC,DOEQ,STRHS,STRHNZ,
     *  C00083,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOTALEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(58),ECHO1,
     *  ROWBF(94),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00084,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00686(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(121),KZC,DOEQ,STRHS,STRHNZ,
     *  C00083,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'WORLDEMISS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(58),ECHO1,
     *  ROWBF(95),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00084,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00688(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(127),KZC,DOEQ,STRHS,STRHNZ,
     *  C00084,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'REALTAXCH',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00689(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00157,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00690(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(43),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00157,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(128),ECHO1,
     *  ROWBF(96),COLBF(128),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PIND_b',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00692(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(43),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(129),ECHO1,
     *  ROWBF(97),COLBF(129),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(15),1,1,1,1,1,1,C00158,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'REALTAXCHB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00694(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00695(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(129),KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,C00160,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(130),ECHO1,
     *  ROWBF(98),COLBF(130),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'E_CO2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(121),ECHO1,
     *  ROWBF(99),COLBF(121),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(131),ECHO1,
     *  ROWBF(99),COLBF(131),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'E_TAXLEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00699(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(132),ECHO1,
     *  ROWBF(100),COLBF(132),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VALCTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(122),ECHO1,
     *  ROWBF(101),COLBF(122),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00702(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(131),KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00162,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(132),ECHO1,
     *  ROWBF(101),COLBF(132),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),4,1,1,1,1,1,C00161,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'FACTORINCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00704(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00705(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(28),ECHO1,
     *  ROWBF(102),COLBF(28),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00031,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(29),ECHO1,
     *  ROWBF(102),COLBF(29),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00031,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(133),ECHO1,
     *  ROWBF(102),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00163,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DINDTAXRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(60),ECHO1,
     *  ROWBF(103),COLBF(60),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(61),ECHO1,
     *  ROWBF(103),COLBF(61),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(62),ECHO1,
     *  ROWBF(103),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(63),ECHO1,
     *  ROWBF(103),COLBF(63),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(64),ECHO1,
     *  ROWBF(103),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(65),ECHO1,
     *  ROWBF(103),COLBF(65),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(66),ECHO1,
     *  ROWBF(103),COLBF(66),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(134),ECHO1,
     *  ROWBF(103),COLBF(134),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DTAXRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(60),ECHO1,
     *  ROWBF(104),COLBF(60),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(61),ECHO1,
     *  ROWBF(104),COLBF(61),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(62),ECHO1,
     *  ROWBF(104),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(63),ECHO1,
     *  ROWBF(104),COLBF(63),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(64),ECHO1,
     *  ROWBF(104),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(65),ECHO1,
     *  ROWBF(104),COLBF(65),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(66),ECHO1,
     *  ROWBF(104),COLBF(66),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(67),ECHO1,
     *  ROWBF(104),COLBF(67),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(135),ECHO1,
     *  ROWBF(104),COLBF(135),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00018')
      RETURN
      END
      SUBROUTINE S00726(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00164,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      REAL C00164(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "y"',
     *  ' in equation "REGIONALINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'y',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       42)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00052(I00002)-C00164(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(42),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(105),COLBF(42),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "y"',
     *  ' in equation "REGIONALINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00726')
      RETURN
      END
      SUBROUTINE S00730(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_indtaxr"',
     *  ' in equation "REGIONALINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_indtaxr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      134)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(134),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(105),COLBF(134),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "del_indtaxr"',
     *  ' in equation "REGIONALINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00730')
      RETURN
      END
      SUBROUTINE S00754(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00086,C00090,C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00151(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PRICEINDEXREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      RS1=-C00151(I00002)*C00048(I00001,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00090(I00001,I00002))*C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(111),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PRICEINDEXREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00754')
      RETURN
      END
      SUBROUTINE S00755(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00088,C00090,C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00151(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PRICEINDEXREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      RS1=-C00151(I00002)*C00048(I00001,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00090(I00001,I00002)*C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(111),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PRICEINDEXREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00755')
      RETURN
      END
      SUBROUTINE S00756(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00236,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00236(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PRICEINDEXREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00236(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(111),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PRICEINDEXREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00756')
      RETURN
      END
      SUBROUTINE S00759(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00166,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00166(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "y"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'y',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       42)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=-1.0
      RS2=C00166(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(42),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(112),COLBF(42),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "y"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00759')
      RETURN
      END
      SUBROUTINE S00760(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00166,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00166(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "p"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'p',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       43)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=1.0
      RS2=C00166(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(43),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(112),COLBF(43),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "p"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00760')
      RETURN
      END
      SUBROUTINE S00761(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00166,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00166(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=1.0
      RS2=C00166(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(112),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00761')
      RETURN
      END
      SUBROUTINE S00762(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00167,C00170,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00167(SSZ(1))
      REAL C00170(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      123)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00170(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00167(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(112),COLBF(123),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00762')
      RETURN
      END
      SUBROUTINE S00763(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00168,C00171,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00168(SSZ(1))
      REAL C00171(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      124)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00171(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00168(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(124),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(112),COLBF(124),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00763')
      RETURN
      END
      SUBROUTINE S00764(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00169,C00172,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00169(SSZ(1))
      REAL C00172(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      125)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00172(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00169(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(125),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(112),COLBF(125),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "UTILITY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00764')
      RETURN
      END
      SUBROUTINE S00775(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(115),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00775')
      RETURN
      END
      SUBROUTINE S00776(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00178,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00178(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00178(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(115),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00776')
      RETURN
      END
      SUBROUTINE S00778(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00176,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00176(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      141)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-C00176(SSMP(SSMPST(1)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(141),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(115),COLBF(141),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00778')
      RETURN
      END
      SUBROUTINE S00779(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tradslack"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tradslack',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      142)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(142),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(115),COLBF(142),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tradslack"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00779')
      RETURN
      END
      SUBROUTINE M00019(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'REGIONALINCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00726(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(42),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00164,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(59),ECHO1,
     *  ROWBF(105),COLBF(59),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(122),ECHO1,
     *  ROWBF(105),COLBF(122),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(133),ECHO1,
     *  ROWBF(105),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00163,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00730(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(134),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(136),ECHO1,
     *  ROWBF(105),COLBF(136),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00052,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DPARAV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(123),ECHO1,
     *  ROWBF(106),COLBF(123),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00150,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(124),ECHO1,
     *  ROWBF(106),COLBF(124),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00151,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(125),ECHO1,
     *  ROWBF(106),COLBF(125),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00152,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(137),ECHO1,
     *  ROWBF(106),COLBF(137),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'UTILITELASTIC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(51),ECHO1,
     *  ROWBF(107),COLBF(51),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00150,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(126),ECHO1,
     *  ROWBF(107),COLBF(126),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(137),ECHO1,
     *  ROWBF(107),COLBF(137),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVCONSEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(108),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(51),ECHO1,
     *  ROWBF(108),COLBF(51),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(52),ECHO1,
     *  ROWBF(108),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(123),ECHO1,
     *  ROWBF(108),COLBF(123),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(126),ECHO1,
     *  ROWBF(108),COLBF(126),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GOVCONSEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(109),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(48),ECHO1,
     *  ROWBF(109),COLBF(48),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(124),ECHO1,
     *  ROWBF(109),COLBF(124),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(126),ECHO1,
     *  ROWBF(109),COLBF(126),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'SAVING',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(1),ECHO1,
     *  ROWBF(110),COLBF(1),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(2),ECHO1,
     *  ROWBF(110),COLBF(2),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(110),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(125),ECHO1,
     *  ROWBF(110),COLBF(125),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(126),ECHO1,
     *  ROWBF(110),COLBF(126),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRICEINDEXREG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(1),ECHO1,
     *  ROWBF(111),COLBF(1),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00152,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00754(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00086,C00090,C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00755(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00088,C00090,C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00756(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00236,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(43),ECHO1,
     *  ROWBF(111),COLBF(43),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(50),ECHO1,
     *  ROWBF(111),COLBF(50),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00150,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'UTILITY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00759(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(42),KZC,DOEQ,STRHS,STRHNZ,
     *  C00166,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00760(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(43),KZC,DOEQ,STRHS,STRHNZ,
     *  C00166,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00761(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00166,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00762(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00167,C00170,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00763(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00168,C00171,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00764(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(125),KZC,DOEQ,STRHS,STRHNZ,
     *  C00169,C00172,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(138),ECHO1,
     *  ROWBF(112),COLBF(138),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(140),ECHO1,
     *  ROWBF(112),COLBF(140),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DISTPARSUM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(123),ECHO1,
     *  ROWBF(113),COLBF(123),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00167,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(124),ECHO1,
     *  ROWBF(113),COLBF(124),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00168,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(125),ECHO1,
     *  ROWBF(113),COLBF(125),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00169,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(139),ECHO1,
     *  ROWBF(113),COLBF(139),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00165,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLDOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(4),ECHO1,
     *  ROWBF(114),COLBF(4),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00175,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(12),ECHO1,
     *  ROWBF(114),COLBF(12),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00174,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(22),ECHO1,
     *  ROWBF(114),COLBF(22),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00173,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(141),ECHO1,
     *  ROWBF(114),COLBF(141),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLTRD_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00775(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00776(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00178,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(115),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00778(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(141),KZC,DOEQ,STRHS,STRHNZ,
     *  C00176,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00779(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(142),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00019')
      RETURN
      END
      SUBROUTINE S00780(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(116),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00780')
      RETURN
      END
      SUBROUTINE S00781(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00178,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00178(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00178(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(116),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00781')
      RETURN
      END
      SUBROUTINE S00782(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00176,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00176(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      141)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-C00176(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(141),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(116),COLBF(141),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00782')
      RETURN
      END
      SUBROUTINE S00783(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tradslack"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tradslack',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      142)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(142),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(116),COLBF(142),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tradslack"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00783')
      RETURN
      END
      SUBROUTINE S00784(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00076,C00086,C00090,C00182,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00182(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00182(I00001,I00002)*(-1.0+C00076(I00001))*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-C00182(I00001,I00002)*C00048(I00011,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00090(I00011,I00002))*C00086(I00011,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00011))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00784')
      RETURN
      END
      SUBROUTINE S00785(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00088,C00090,C00182,C00285,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00182(SSZ(2),SSZ(1))
      REAL C00285(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00285(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-C00182(I00001,I00002)*C00048(I00011,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00090(I00011,I00002)*C00088(I00011,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00785')
      RETURN
      END
      SUBROUTINE S00786(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00099,C00181,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00181(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00181(I00001,I00002)*C00076(I00001)*C00099(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00786')
      RETURN
      END
      SUBROUTINE S00787(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00286,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00286(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00286(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00787')
      RETURN
      END
      SUBROUTINE S00788(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00095,C00181,C00182,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00181(SSZ(2),SSZ(1))
      REAL C00182(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00181(I00001,I00002)*(-1.0+C00095(I00001,I00002))-
     *  C00182(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00788')
      RETURN
      END
      SUBROUTINE S00790(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00095,C00181,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00181(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yp"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       52)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00181(I00001,I00002)*C00095(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(52),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(52),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "yp"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00790')
      RETURN
      END
      SUBROUTINE S00792(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00096,C00181,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL C00181(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 4 I00008=1,SSZ(2)
      ENTRY=-C00181(I00001,I00002)*C00096(I00001,I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00008+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    4 CONTINUE
      ENTRY=-C00181(I00001,I00002)*C00076(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00792')
      RETURN
      END
      SUBROUTINE S00793(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00180,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00180(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pft"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pft',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-C00180(I00001,I00004,I00002)*C00076(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pft"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00793')
      RETURN
      END
      SUBROUTINE S00794(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00180,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00180(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-C00180(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00794')
      RETURN
      END
      SUBROUTINE S00795(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLENDWM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(11)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(118),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLENDWM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00795')
      RETURN
      END
      SUBROUTINE S00796(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "endwslack"',
     *  ' in equation "MKTCLENDWM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'endwslack',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       46)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(11)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(11)-1+I00001)+SSZ(6)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(46),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(118),COLBF(46),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "endwslack"',
     *  ' in equation "MKTCLENDWM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00796')
      RETURN
      END
      SUBROUTINE S00797(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00183,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00183(SSZ(11),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLENDWM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(11)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-C00183(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(118),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLENDWM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00797')
      RETURN
      END
      SUBROUTINE S00799(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(7)
      DO     3 I00001=1,SSZ(10)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(119),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00799')
      RETURN
      END
      SUBROUTINE S00809(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "REALRETURN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(123),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "REALRETURN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00809')
      RETURN
      END
      SUBROUTINE S00812(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PRIMFACTPR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(124),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PRIMFACTPR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00812')
      RETURN
      END
      SUBROUTINE S00816(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00036,C00320,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00320(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "REGSUPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(2)
      ENTRY=C00320(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 4 I00005=1,SSZ(3)
      ENTRY=-C00036(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(126),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "REGSUPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00816')
      RETURN
      END
      SUBROUTINE S00820(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "REGDEMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00033(I00001,I00008,I00002)*C00146(I00001,I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00008-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(127),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "REGDEMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00820')
      RETURN
      END
      SUBROUTINE S00821(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "REGDEMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=C00033(I00001,I00008,I00002)*C00146(I00001,I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00008-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(127),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "REGDEMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00821')
      RETURN
      END
      SUBROUTINE S00822(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "REGDEMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00008=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=C00033(I00001,I00008,I00002)*C00146(I00001,I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00008-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(127),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "REGDEMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00822')
      RETURN
      END
      SUBROUTINE S00823(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00361,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00361(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "REGDEMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(3)
      ENTRY=C00361(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(127),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "REGDEMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00823')
      RETURN
      END
      SUBROUTINE M00020(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLTRD_NMRG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00780(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00781(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00178,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00782(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(141),KZC,DOEQ,STRHS,STRHNZ,
     *  C00176,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00783(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(142),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLIMP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00784(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00076,C00086,C00090,C00182,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00785(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00088,C00090,C00182,C00285,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00786(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00099,C00181,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00787(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00286,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00788(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00095,C00181,C00182,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(117),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00182,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00790(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(52),KZC,DOEQ,STRHS,STRHNZ,
     *  C00095,C00181,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(55),ECHO1,
     *  ROWBF(117),COLBF(55),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00792(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00096,C00181,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00793(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00180,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00794(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00180,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLENDWM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00795(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00796(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(46),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00797(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00183,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLENDWS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(45),ECHO1,
     *  ROWBF(119),COLBF(45),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00799(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'WALRAS_S',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(56),ECHO1,
     *  ROWBF(120),COLBF(56),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(57),ECHO1,
     *  ROWBF(120),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(143),ECHO1,
     *  ROWBF(120),COLBF(143),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'WALRAS_D',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(1),ECHO1,
     *  ROWBF(121),COLBF(1),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00009,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(2),ECHO1,
     *  ROWBF(121),COLBF(2),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00009,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(144),ECHO1,
     *  ROWBF(121),COLBF(144),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00079,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'WALRAS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(143),ECHO1,
     *  ROWBF(122),COLBF(143),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(144),ECHO1,
     *  ROWBF(122),COLBF(144),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(145),ECHO1,
     *  ROWBF(122),COLBF(145),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'REALRETURN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00809(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(50),ECHO1,
     *  ROWBF(123),COLBF(50),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(150),ECHO1,
     *  ROWBF(123),COLBF(150),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIMFACTPR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00812(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(151),ECHO1,
     *  ROWBF(124),COLBF(151),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00188,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIMFACTPRWLD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(151),ECHO1,
     *  ROWBF(125),COLBF(151),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00188,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(152),ECHO1,
     *  ROWBF(125),COLBF(152),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00189,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'REGSUPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00816(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00036,C00320,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(101),ECHO1,
     *  ROWBF(126),COLBF(101),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00321,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(102),ECHO1,
     *  ROWBF(126),COLBF(102),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00034,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(153),ECHO1,
     *  ROWBF(126),COLBF(153),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00185,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'REGDEMPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00820(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00821(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00822(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00823(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00361,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(127),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00362,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(110),ECHO1,
     *  ROWBF(127),COLBF(110),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),SSZ(1),1,1,1,1,1,C00363,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(127),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00364,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(127),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00365,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(154),ECHO1,
     *  ROWBF(127),COLBF(154),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00187,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOTeq',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(153),ECHO1,
     *  ROWBF(128),COLBF(153),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(154),ECHO1,
     *  ROWBF(128),COLBF(154),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(155),ECHO1,
     *  ROWBF(128),COLBF(155),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00020')
      RETURN
      END
      SUBROUTINE S00832(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00036,C00146,C00322,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      REAL C00322(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(3)
      ENTRY=-C00036(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 4 I00001=1,SSZ(2)
      ENTRY=C00322(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=C00033(I00001,I00003,I00002)*C00146(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00832')
      RETURN
      END
      SUBROUTINE S00833(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,C00090,C00231,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00231(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=C00231(I00001,I00002)*C00090(I00001,I00002)*
     *  C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00833')
      RETURN
      END
      SUBROUTINE S00835(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-C00034(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=C00033(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00835')
      RETURN
      END
      SUBROUTINE S00837(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00237,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00237(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00237(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00837')
      RETURN
      END
      SUBROUTINE S00843(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,C00323,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      REAL C00323(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-C00033(I00001,I00003,I00002)*C00146(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 5 I00001=1,SSZ(2)
      ENTRY=C00323(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00843')
      RETURN
      END
      SUBROUTINE S00844(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,C00146,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-C00033(I00001,I00003,I00002)*C00146(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=C00034(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00844')
      RETURN
      END
      SUBROUTINE S00845(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00366,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00366(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(3)
      ENTRY=C00366(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "VGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00845')
      RETURN
      END
      SUBROUTINE S00851(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00036,C00146,C00324,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      REAL C00324(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(2)
      ENTRY=C00324(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 4 I00005=1,SSZ(3)
      ENTRY=-C00036(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=C00033(I00001,I00003,I00002)*C00146(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(130),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00851')
      RETURN
      END
      SUBROUTINE S00852(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-C00048(I00001,I00002)*C00090(I00001,I00002)*
     *  C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(130),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00852')
      RETURN
      END
      SUBROUTINE S00854(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00238,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00238(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00238(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(130),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00854')
      RETURN
      END
      SUBROUTINE S00856(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,C00323,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      REAL C00323(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-C00033(I00001,I00003,I00002)*C00146(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 5 I00001=1,SSZ(2)
      ENTRY=C00323(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(130),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00856')
      RETURN
      END
      SUBROUTINE S00857(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,C00146,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-C00033(I00001,I00003,I00002)*C00146(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=C00034(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(130),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00857')
      RETURN
      END
      SUBROUTINE S00858(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00366,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00366(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(3)
      ENTRY=C00366(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(130),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "PGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00858')
      RETURN
      END
      SUBROUTINE S00864(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00090,C00232,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00232(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "QGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=C00232(I00001,I00002)*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(131),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "QGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00864')
      RETURN
      END
      SUBROUTINE S00865(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,C00090,C00232,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00232(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "QGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=C00232(I00001,I00002)*C00090(I00001,I00002)*
     *  C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(131),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "QGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00865')
      RETURN
      END
      SUBROUTINE S00866(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "QGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-C00034(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=C00033(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(131),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "QGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00866')
      RETURN
      END
      SUBROUTINE S00868(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00239,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00239(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "QGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00239(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(131),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "QGDP_r"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00868')
      RETURN
      END
      SUBROUTINE S00875(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00325,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00325(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00325(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(133),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00875')
      RETURN
      END
      SUBROUTINE S00876(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(133),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00876')
      RETURN
      END
      SUBROUTINE S00878(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00326,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00326(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00326(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(133),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00878')
      RETURN
      END
      SUBROUTINE S00879(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(133),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00879')
      RETURN
      END
      SUBROUTINE S00880(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00184(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "vxwfob"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'vxwfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      146)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00184(SSMP(SSMPST(1)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(146),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(133),COLBF(146),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "vxwfob"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00880')
      RETURN
      END
      SUBROUTINE S00881(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00327,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00327(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00327(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00881')
      RETURN
      END
      SUBROUTINE S00882(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00882')
      RETURN
      END
      SUBROUTINE S00883(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00328,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00328(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00328(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00883')
      RETURN
      END
      SUBROUTINE S00884(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00884')
      RETURN
      END
      SUBROUTINE S00885(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00184(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "vxwfob"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'vxwfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      146)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00184(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(146),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(146),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "vxwfob"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00885')
      RETURN
      END
      SUBROUTINE M00021(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VGDP_r',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00832(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00036,C00146,C00322,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00833(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,C00090,C00231,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(29),ECHO1,
     *  ROWBF(129),COLBF(29),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00835(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(129),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00036,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00837(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00237,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(129),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00261,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(129),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00230,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(52),ECHO1,
     *  ROWBF(129),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00262,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(70),ECHO1,
     *  ROWBF(129),COLBF(70),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00263,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(95),ECHO1,
     *  ROWBF(129),COLBF(95),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00843(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,C00323,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00844(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,C00146,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00845(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00366,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(129),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00367,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(110),ECHO1,
     *  ROWBF(129),COLBF(110),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),SSZ(1),1,1,1,1,1,C00368,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(129),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00369,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(129),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00370,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(156),ECHO1,
     *  ROWBF(129),COLBF(156),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00190,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PGDP_r',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00851(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00036,C00146,C00324,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00852(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(29),ECHO1,
     *  ROWBF(130),COLBF(29),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00854(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00238,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(70),ECHO1,
     *  ROWBF(130),COLBF(70),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00050,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00856(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,C00323,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00857(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,C00146,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00858(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00366,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(130),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00367,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(110),ECHO1,
     *  ROWBF(130),COLBF(110),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),SSZ(1),1,1,1,1,1,C00368,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(130),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00369,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(130),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00370,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(157),ECHO1,
     *  ROWBF(130),COLBF(157),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00190,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QGDP_r',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00864(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00090,C00232,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00865(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,C00090,C00232,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00866(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(131),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00036,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00868(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00239,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(131),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00261,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(131),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00230,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(52),ECHO1,
     *  ROWBF(131),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00262,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(70),ECHO1,
     *  ROWBF(131),COLBF(70),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00264,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(95),ECHO1,
     *  ROWBF(131),COLBF(95),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(158),ECHO1,
     *  ROWBF(131),COLBF(158),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00190,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VREGEX_ir_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00875(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00325,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00876(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(133),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00036,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00878(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00326,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00879(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00880(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(146),KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VREGEX_ir_NMRG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00881(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00327,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00882(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00883(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00328,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00884(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00885(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(146),KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00021')
      RETURN
      END
      SUBROUTINE S00892(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "VREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=-C00033(I00001,I00002,I00003)*C00146(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(138),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00892')
      RETURN
      END
      SUBROUTINE S00894(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "VREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00033(I00001,I00002,I00003)*C00146(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(138),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "VREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00894')
      RETURN
      END
      SUBROUTINE S00895(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "VREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00033(I00001,I00002,I00003)*C00146(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(138),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "VREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00895')
      RETURN
      END
      SUBROUTINE S00896(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00371,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00371(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "VREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(3)
      ENTRY=C00371(I00005,I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(138),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "VREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00896')
      RETURN
      END
      SUBROUTINE S00898(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ats"',
     *  ' in equation "VREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ats',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00033(I00001,I00002,I00003)*C00343(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(110),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(138),COLBF(110),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ats"',
     *  ' in equation "VREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00898')
      RETURN
      END
      SUBROUTINE S00906(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00195,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00195(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "VWLDOUT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      ENTRY=-C00195(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(141),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "VWLDOUT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00906')
      RETURN
      END
      SUBROUTINE S00909(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00086,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00048(I00001,I00003)*(1.0-1.0)*(1  -
     *  C00090(I00001,I00003))*C00086(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 5 I00003=1,SSZ(1)
      DO 4 I00011=1,SSZ(2)
      RS1=-C00048(I00001,I00003)*C00048(I00011,I00003)
      RS2=C00049(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00090(I00011,I00003))*C00086(I00011,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00011))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(142),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00909')
      RETURN
      END
      SUBROUTINE S00910(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00088,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00048(I00001,I00003)*(1.0-1.0)*C00090(I00001,I00003)*
     *  C00088(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 5 I00003=1,SSZ(1)
      DO 4 I00011=1,SSZ(2)
      RS1=-C00048(I00001,I00003)*C00048(I00011,I00003)
      RS2=C00049(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00090(I00011,I00003)*C00088(I00011,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(142),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00910')
      RETURN
      END
      SUBROUTINE S00911(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00240,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00240(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00240(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(142),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00911')
      RETURN
      END
      SUBROUTINE S00912(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00050,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 2 I00003=1,SSZ(1)
      ENTRY=-C00048(I00001,I00003)+C00050(I00001,I00003)*(-1.0+
     *  C00095(I00001,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00003
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(142),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00912')
      RETURN
      END
      SUBROUTINE S00914(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yp"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       52)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 2 I00003=1,SSZ(1)
      ENTRY=-C00050(I00001,I00003)*C00095(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00003
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(52),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(142),COLBF(52),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "yp"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00914')
      RETURN
      END
      SUBROUTINE S00915(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00050(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 5 I00003=1,SSZ(1)
      DO 4 I00008=1,SSZ(2)
      ENTRY=-C00050(I00001,I00003)*C00096(I00001,I00008,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00008+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(142),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00915')
      RETURN
      END
      SUBROUTINE S00916(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pft"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pft',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      ENTRY=-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(142),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pft"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00916')
      RETURN
      END
      SUBROUTINE S00917(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      ENTRY=-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(142),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00917')
      RETURN
      END
      SUBROUTINE S00919(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00325,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00325(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00325(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(143),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00919')
      RETURN
      END
      SUBROUTINE S00920(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00326,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00326(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00326(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(143),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00920')
      RETURN
      END
      SUBROUTINE S00921(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(143),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00921')
      RETURN
      END
      SUBROUTINE S00922(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00184(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxw"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxw',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      160)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00184(SSMP(SSMPST(1)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(160),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(143),COLBF(160),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxw"',
     *  ' in equation "PREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00922')
      RETURN
      END
      SUBROUTINE S00923(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00327,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00327(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00327(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(144),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00923')
      RETURN
      END
      SUBROUTINE S00924(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00328,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00328(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "PREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00328(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(144),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "PREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00924')
      RETURN
      END
      SUBROUTINE S00925(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "PREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(144),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "PREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00925')
      RETURN
      END
      SUBROUTINE S00926(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00184(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxw"',
     *  ' in equation "PREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxw',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      160)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00184(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(160),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(144),COLBF(160),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxw"',
     *  ' in equation "PREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00926')
      RETURN
      END
      SUBROUTINE S00933(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=-C00033(I00001,I00002,I00003)*C00146(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(148),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00933')
      RETURN
      END
      SUBROUTINE S00934(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "PREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00033(I00001,I00002,I00003)*C00146(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(148),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "PREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00934')
      RETURN
      END
      SUBROUTINE S00935(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "PREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00033(I00001,I00002,I00003)*C00146(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(148),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "PREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00935')
      RETURN
      END
      SUBROUTINE S00936(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00371,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00371(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "PREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(3)
      ENTRY=C00371(I00005,I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(148),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "PREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00936')
      RETURN
      END
      SUBROUTINE S00938(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ats"',
     *  ' in equation "PREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ats',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00033(I00001,I00002,I00003)*C00343(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(110),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(148),COLBF(110),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ats"',
     *  ' in equation "PREGIM_is"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00938')
      RETURN
      END
      SUBROUTINE M00022(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VREGEX_r',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(146),ECHO1,
     *  ROWBF(135),COLBF(146),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00184,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(148),ECHO1,
     *  ROWBF(135),COLBF(148),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00185,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VWLDEX_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(146),ECHO1,
     *  ROWBF(136),COLBF(146),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00184,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(161),ECHO1,
     *  ROWBF(136),COLBF(161),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00191,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VWLDEX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(148),ECHO1,
     *  ROWBF(137),COLBF(148),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00185,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(162),ECHO1,
     *  ROWBF(137),COLBF(162),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00192,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VREGIM_is',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00892(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(31),ECHO1,
     *  ROWBF(138),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00033,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00894(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00895(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00896(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00371,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(138),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00372,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00898(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(138),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00372,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(138),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),SSZ(1),1,1,1,1,C00373,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(147),ECHO1,
     *  ROWBF(138),COLBF(147),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00186,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VREGIM_s',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(147),ECHO1,
     *  ROWBF(139),COLBF(147),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00186,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(149),ECHO1,
     *  ROWBF(139),COLBF(149),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00187,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VWLDIM_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(147),ECHO1,
     *  ROWBF(140),COLBF(147),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00186,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(163),ECHO1,
     *  ROWBF(140),COLBF(163),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00193,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VWLDOUT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00906(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00195,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(160),ECHO1,
     *  ROWBF(141),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00195,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(164),ECHO1,
     *  ROWBF(141),COLBF(164),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00196,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VWLDOUTUSE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00909(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00086,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00910(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00088,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00911(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00240,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00912(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00050,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(142),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00048,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00914(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(52),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00915(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00916(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00917(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(165),ECHO1,
     *  ROWBF(142),COLBF(165),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00197,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PREGEX_ir_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00919(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00325,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00920(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00326,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00921(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00922(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(160),KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PREGEX_ir_NMRG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00923(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00327,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00924(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00328,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00925(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00926(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(160),KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PREGEX_r',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(160),ECHO1,
     *  ROWBF(145),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00184,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(166),ECHO1,
     *  ROWBF(145),COLBF(166),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00185,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PWLDEX_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(160),ECHO1,
     *  ROWBF(146),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00184,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(167),ECHO1,
     *  ROWBF(146),COLBF(167),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00191,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PWLDEX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(166),ECHO1,
     *  ROWBF(147),COLBF(166),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00185,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(168),ECHO1,
     *  ROWBF(147),COLBF(168),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00192,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PREGIM_is',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00933(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00934(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00935(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00936(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00371,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(148),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00372,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00938(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(148),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00372,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(148),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),SSZ(1),1,1,1,1,C00373,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(169),ECHO1,
     *  ROWBF(148),COLBF(169),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00186,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00022')
      RETURN
      END
      SUBROUTINE S00948(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 2 I00003=1,SSZ(1)
      ENTRY=-C00048(I00001,I00003)*(1  -C00090(I00001,I00003))*
     *  C00086(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(152),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00948')
      RETURN
      END
      SUBROUTINE S00949(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 2 I00003=1,SSZ(1)
      ENTRY=-C00048(I00001,I00003)*C00090(I00001,I00003)*
     *  C00088(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(152),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00949')
      RETURN
      END
      SUBROUTINE S00950(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00048,C00087,C00089,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00048(I00001,I00003)*(-C00090(I00001,I00003)*100.0 *
     *  C00089(I00001,I00003)-(1  -C00090(I00001,I00003))*100.0 *
     *  C00087(I00001,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(152),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00950')
      RETURN
      END
      SUBROUTINE S00952(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pft"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pft',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      ENTRY=-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(152),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pft"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00952')
      RETURN
      END
      SUBROUTINE S00954(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "QREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(153),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "QREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00954')
      RETURN
      END
      SUBROUTINE S00956(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00184(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxw"',
     *  ' in equation "QREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxw',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      174)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00184(SSMP(SSMPST(1)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(174),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(153),COLBF(174),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxw"',
     *  ' in equation "QREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00956')
      RETURN
      END
      SUBROUTINE S00957(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "QREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(154),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "QREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00957')
      RETURN
      END
      SUBROUTINE S00958(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00184(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxw"',
     *  ' in equation "QREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxw',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      174)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00184(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(174),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(154),COLBF(174),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxw"',
     *  ' in equation "QREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00958')
      RETURN
      END
      SUBROUTINE S00971(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00195,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00195(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "QWLDOUT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      ENTRY=-C00195(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(161),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "QWLDOUT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00971')
      RETURN
      END
      SUBROUTINE S00973(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00086,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00048(I00001,I00003)*(1  -C00090(I00001,I00003))*
     *  C00086(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 5 I00003=1,SSZ(1)
      DO 4 I00011=1,SSZ(2)
      RS1=-C00048(I00001,I00003)*C00048(I00011,I00003)
      RS2=C00049(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00090(I00011,I00003))*C00086(I00011,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00011))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(162),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00973')
      RETURN
      END
      SUBROUTINE S00974(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00088,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00048(I00001,I00003)*C00090(I00001,I00003)*
     *  C00088(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 5 I00003=1,SSZ(1)
      DO 4 I00011=1,SSZ(2)
      RS1=-C00048(I00001,I00003)*C00048(I00011,I00003)
      RS2=C00049(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00090(I00011,I00003)*C00088(I00011,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(162),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00974')
      RETURN
      END
      SUBROUTINE S00975(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00241,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00241(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00241(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(162),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00975')
      RETURN
      END
      SUBROUTINE S00976(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00050,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 2 I00003=1,SSZ(1)
      ENTRY=-C00048(I00001,I00003)+C00050(I00001,I00003)*(-1.0+
     *  C00095(I00001,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00003
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(162),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00976')
      RETURN
      END
      SUBROUTINE S00978(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yp"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       52)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 2 I00003=1,SSZ(1)
      ENTRY=-C00050(I00001,I00003)*C00095(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00003
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(52),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(162),COLBF(52),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "yp"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00978')
      RETURN
      END
      SUBROUTINE S00979(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00096,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00008=1,SSZ(2)
      ENTRY=-C00050(I00001,I00003)*C00096(I00001,I00008,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00008+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(162),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00979')
      RETURN
      END
      SUBROUTINE S00980(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      ENTRY=-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(162),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "QWLDOUTU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00980')
      RETURN
      END
      SUBROUTINE S00982(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00184(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "vxwfob"',
     *  ' in equation "TRADEBAL_i"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'vxwfob',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      146)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-C00184(I00001,I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(146),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(163),COLBF(146),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "vxwfob"',
     *  ' in equation "TRADEBAL_i"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00982')
      RETURN
      END
      SUBROUTINE S00983(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00186,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00186(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "viwcif"',
     *  ' in equation "TRADEBAL_i"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'viwcif',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      147)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00186(I00001,I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(147),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(163),COLBF(147),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "viwcif"',
     *  ' in equation "TRADEBAL_i"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00983')
      RETURN
      END
      SUBROUTINE S00985(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00185,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00185(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "vxwreg"',
     *  ' in equation "TRADEBALANCE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'vxwreg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      148)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00185(I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(148),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(164),COLBF(148),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "vxwreg"',
     *  ' in equation "TRADEBALANCE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00985')
      RETURN
      END
      SUBROUTINE S00986(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00187,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00187(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "viwreg"',
     *  ' in equation "TRADEBALANCE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'viwreg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      149)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00187(I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(149),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(164),COLBF(149),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "viwreg"',
     *  ' in equation "TRADEBALANCE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00986')
      RETURN
      END
      SUBROUTINE S00993(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "DTBALR"',
     *  ' in equation "DTBALRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'DTBALR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      186)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100*C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(186),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(166),COLBF(186),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "DTBALR"',
     *  ' in equation "DTBALRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00993')
      RETURN
      END
      SUBROUTINE M00023(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PREGIM_s',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(169),ECHO1,
     *  ROWBF(149),COLBF(169),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00186,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(170),ECHO1,
     *  ROWBF(149),COLBF(170),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00187,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PWLDIM_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(169),ECHO1,
     *  ROWBF(150),COLBF(169),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00186,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(171),ECHO1,
     *  ROWBF(150),COLBF(171),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00193,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PWLDOUT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(160),ECHO1,
     *  ROWBF(151),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00195,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(172),ECHO1,
     *  ROWBF(151),COLBF(172),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00196,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PWLDUSE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00948(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00949(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00950(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00048,C00087,C00089,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(70),ECHO1,
     *  ROWBF(152),COLBF(70),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00050,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00952(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(173),ECHO1,
     *  ROWBF(152),COLBF(173),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00197,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QREGEX_ir_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00954(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(153),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00036,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00956(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(174),KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QREGEX_ir_NMRG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00957(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00958(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(174),KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QREGEX_r',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(174),ECHO1,
     *  ROWBF(155),COLBF(174),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00184,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(175),ECHO1,
     *  ROWBF(155),COLBF(175),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00185,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QWLDEX_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(174),ECHO1,
     *  ROWBF(156),COLBF(174),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00184,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(176),ECHO1,
     *  ROWBF(156),COLBF(176),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00191,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QWLDEX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(175),ECHO1,
     *  ROWBF(157),COLBF(175),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00185,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(177),ECHO1,
     *  ROWBF(157),COLBF(177),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00192,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QREGIM_is',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(31),ECHO1,
     *  ROWBF(158),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00033,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(178),ECHO1,
     *  ROWBF(158),COLBF(178),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00186,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QREGIM_s',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(178),ECHO1,
     *  ROWBF(159),COLBF(178),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00186,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(179),ECHO1,
     *  ROWBF(159),COLBF(179),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00187,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QWLDIM_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(178),ECHO1,
     *  ROWBF(160),COLBF(178),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00186,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(180),ECHO1,
     *  ROWBF(160),COLBF(180),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00193,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QWLDOUT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00971(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00195,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(181),ECHO1,
     *  ROWBF(161),COLBF(181),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00196,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QWLDOUTU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00973(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00086,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00974(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00088,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00975(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00241,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00976(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00050,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(162),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00048,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00978(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(52),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00979(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00096,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00980(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(182),ECHO1,
     *  ROWBF(162),COLBF(182),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00197,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TRADEBAL_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00982(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(146),KZC,DOEQ,STRHS,STRHNZ,
     *  C00184,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00983(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(147),KZC,DOEQ,STRHS,STRHNZ,
     *  C00186,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(183),ECHO1,
     *  ROWBF(163),COLBF(183),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TRADEBALANCE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00985(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(148),KZC,DOEQ,STRHS,STRHNZ,
     *  C00185,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00986(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(149),KZC,DOEQ,STRHS,STRHNZ,
     *  C00187,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(184),ECHO1,
     *  ROWBF(164),COLBF(184),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TRAEMTRADBAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(59),ECHO1,
     *  ROWBF(165),COLBF(59),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(184),ECHO1,
     *  ROWBF(165),COLBF(184),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(185),ECHO1,
     *  ROWBF(165),COLBF(185),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DTBALRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(166),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00198,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(184),ECHO1,
     *  ROWBF(166),COLBF(184),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00993(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(186),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00023')
      RETURN
      END
      SUBROUTINE S00994(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00010,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgd"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=-C00010(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgd"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00994')
      RETURN
      END
      SUBROUTINE S00995(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00048,C00049,C00086,C00090,C00278,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00278(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=C00278(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(13)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-C00013(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00048(I00011,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00090(I00011,I00002))*C00086(I00011,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00011))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00995')
      RETURN
      END
      SUBROUTINE S00996(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00048,C00049,C00088,C00090,C00287,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00287(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=C00287(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-C00013(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00048(I00011,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00090(I00011,I00002)*C00088(I00011,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00996')
      RETURN
      END
      SUBROUTINE S00997(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpd"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=-C00016(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpd"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00997')
      RETURN
      END
      SUBROUTINE S00998(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,C00097,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00097(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=-C00016(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00097(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(13),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00998')
      RETURN
      END
      SUBROUTINE S00999(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))*C00099(SSMP(SSMPST(13)-1+
     *  I00001),I00002)-C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00099(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00999')
      RETURN
      END
      SUBROUTINE S01000(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfd"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-C00024(SSMP(SSMPST(13)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(22),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfd"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01000')
      RETURN
      END
      SUBROUTINE S01001(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00288,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00288(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=C00288(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01001')
      RETURN
      END
      SUBROUTINE S01002(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00019,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=C00019(SSMP(SSMPST(13)-1+I00001),I00002)*(-1.0+
     *  C00095(SSMP(SSMPST(13)-1+I00001),I00002))-
     *  C00013(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01002')
      RETURN
      END
      SUBROUTINE S01003(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ug"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ug',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       49)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=-C00013(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(49),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(49),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ug"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01003')
      RETURN
      END
      SUBROUTINE S01004(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yp"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       52)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=-C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00095(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(52),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(52),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "yp"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01004')
      RETURN
      END
      SUBROUTINE S01005(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(13)
      RWN=RWN+1
      DO 4 I00008=1,SSZ(2)
      ENTRY=-C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00096(SSMP(SSMPST(13)-1+I00001),I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00008+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    4 CONTINUE
      ENTRY=-C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01005')
      RETURN
      END
      SUBROUTINE S01006(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00076,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pft"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pft',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-C00026(SSMP(SSMPST(13)-1+I00001),I00004,I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pft"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01006')
      RETURN
      END
      SUBROUTINE S01007(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-C00026(SSMP(SSMPST(13)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(13)-1+
     *  I00001)))+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "TOTVALEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01007')
      RETURN
      END
      SUBROUTINE S01009(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00010,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgd"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=-C00010(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgd"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01009')
      RETURN
      END
      SUBROUTINE S01010(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00048,C00049,C00076,C00086,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=-C00013(SSMP(SSMPST(13)-1+I00001),I00002)*(-1.0+
     *  C00076(SSMP(SSMPST(13)-1+I00001)))*(1  -C00090(SSMP(SSMPST(13)-
     *  1+I00001),I00002))*C00086(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(13)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-C00013(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00048(I00011,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00090(I00011,I00002))*C00086(I00011,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00011))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01010')
      RETURN
      END
      SUBROUTINE S01011(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00048,C00049,C00088,C00090,C00289,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00289(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=C00289(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-C00013(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00048(I00011,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00090(I00011,I00002)*C00088(I00011,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01011')
      RETURN
      END
      SUBROUTINE S01012(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpd"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=-C00016(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpd"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01012')
      RETURN
      END
      SUBROUTINE S01013(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))*C00099(SSMP(SSMPST(13)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01013')
      RETURN
      END
      SUBROUTINE S01014(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfd"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-C00024(SSMP(SSMPST(13)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(22),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfd"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01014')
      RETURN
      END
      SUBROUTINE S01015(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00290,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00290(SSZ(13),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=C00290(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01015')
      RETURN
      END
      SUBROUTINE S01016(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00019,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=C00019(SSMP(SSMPST(13)-1+I00001),I00002)*(-1.0+
     *  C00095(SSMP(SSMPST(13)-1+I00001),I00002))-
     *  C00013(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01016')
      RETURN
      END
      SUBROUTINE S01017(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ug"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ug',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       49)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=-C00013(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(49),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(49),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ug"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01017')
      RETURN
      END
      SUBROUTINE S01018(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yp"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       52)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      ENTRY=-C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00095(SSMP(SSMPST(13)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(52),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(52),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "yp"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01018')
      RETURN
      END
      SUBROUTINE S01019(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(13)
      RWN=RWN+1
      DO 4 I00008=1,SSZ(2)
      ENTRY=-C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00096(SSMP(SSMPST(13)-1+I00001),I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00008+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    4 CONTINUE
      ENTRY=-C00019(SSMP(SSMPST(13)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01019')
      RETURN
      END
      SUBROUTINE S01020(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00076,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pft"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pft',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-C00026(SSMP(SSMPST(13)-1+I00001),I00004,I00002)*
     *  C00076(SSMP(SSMPST(13)-1+I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pft"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01020')
      RETURN
      END
      SUBROUTINE S01021(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(13)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-C00026(SSMP(SSMPST(13)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(13)-1+
     *  I00001)))+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(168),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "TOTQUAEN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01021')
      RETURN
      END
      SUBROUTINE S01030(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00207(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "PRIVDMNDSEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-1.0+C00207(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(171),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "PRIVDMNDSEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01030')
      RETURN
      END
      SUBROUTINE S01037(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00209,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00209(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ypev"',
     *  ' in equation "UTILELASPRIVEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ypev',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      196)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-C00209(I00001,I00002)
    2 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(196),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(173),COLBF(196),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ypev"',
     *  ' in equation "UTILELASPRIVEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01037')
      RETURN
      END
      SUBROUTINE M00024(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOTVALEN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00994(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00010,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00995(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00048,C00049,C00086,C00090,C00278,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00996(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00048,C00049,C00088,C00090,C00287,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00997(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00998(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,C00097,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00999(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01000(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01001(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00288,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01002(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00019,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01003(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(49),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01004(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(52),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01005(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01006(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00076,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01007(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(187),ECHO1,
     *  ROWBF(167),COLBF(187),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  5,SSZ(1),1,1,1,1,1,C00199,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOTQUAEN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01009(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00010,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01010(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00048,C00049,C00076,C00086,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01011(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00048,C00049,C00088,C00090,C00289,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01012(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01013(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00099,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01014(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01015(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00290,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01016(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00019,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01017(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(49),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01018(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(52),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00095,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01019(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01020(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00076,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01021(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(188),ECHO1,
     *  ROWBF(168),COLBF(188),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  5,SSZ(1),1,1,1,1,1,C00199,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'AVPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(157),ECHO1,
     *  ROWBF(169),COLBF(157),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(187),ECHO1,
     *  ROWBF(169),COLBF(187),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(188),ECHO1,
     *  ROWBF(169),COLBF(188),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(189),ECHO1,
     *  ROWBF(169),COLBF(189),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GOVUSHD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(170),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(192),ECHO1,
     *  ROWBF(170),COLBF(192),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(197),ECHO1,
     *  ROWBF(170),COLBF(197),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVDMNDSEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01030(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(196),ECHO1,
     *  ROWBF(171),COLBF(196),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00207,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(198),ECHO1,
     *  ROWBF(171),COLBF(198),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVATEUEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(172),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(193),ECHO1,
     *  ROWBF(172),COLBF(193),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00208,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(196),ECHO1,
     *  ROWBF(172),COLBF(196),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'UTILELASPRIVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(191),ECHO1,
     *  ROWBF(173),COLBF(191),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01037(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(196),KZC,DOEQ,STRHS,STRHNZ,
     *  C00209,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(198),ECHO1,
     *  ROWBF(173),COLBF(198),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00209,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DPARAVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(123),ECHO1,
     *  ROWBF(174),COLBF(123),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00213,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(124),ECHO1,
     *  ROWBF(174),COLBF(124),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00214,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(125),ECHO1,
     *  ROWBF(174),COLBF(125),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00215,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(200),ECHO1,
     *  ROWBF(174),COLBF(200),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'UTILITELASTICEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(190),ECHO1,
     *  ROWBF(175),COLBF(190),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(191),ECHO1,
     *  ROWBF(175),COLBF(191),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00150,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(200),ECHO1,
     *  ROWBF(175),COLBF(200),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00024')
      RETURN
      END
      SUBROUTINE S01061(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00216(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=1.0
      RS2=C00216(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(180),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01061')
      RETURN
      END
      SUBROUTINE S01062(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00167,C00201,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00167(SSZ(1))
      REAL C00201(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      123)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00201(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00167(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(180),COLBF(123),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01062')
      RETURN
      END
      SUBROUTINE S01063(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00168,C00202,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00168(SSZ(1))
      REAL C00202(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      124)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00202(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00168(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(124),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(180),COLBF(124),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01063')
      RETURN
      END
      SUBROUTINE S01064(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00169,C00203,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00169(SSZ(1))
      REAL C00203(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      125)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=REAL(C00203(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00169(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(125),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(180),COLBF(125),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01064')
      RETURN
      END
      SUBROUTINE S01067(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00216(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yev"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yev',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      195)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=-1.0
      RS2=C00216(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(195),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(180),COLBF(195),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "yev"',
     *  ' in equation "INCOME_EQUIV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01067')
      RETURN
      END
      SUBROUTINE S01068(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00200,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00200(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yev"',
     *  ' in equation "EVREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yev',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      195)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00200(I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(195),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(181),COLBF(195),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "yev"',
     *  ' in equation "EVREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01068')
      RETURN
      END
      SUBROUTINE S01072(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "psave"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'psave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        1)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=0.01  *C00217(I00002)*C00009(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(1),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(1),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "psave"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01072')
      RETURN
      END
      SUBROUTINE S01073(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00064,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*(C00063(I00001,I00002)+
     *  C00064(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01073')
      RETURN
      END
      SUBROUTINE S01074(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00036,C00217,C00329,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00329(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(2)
      ENTRY=C00329(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 4 I00005=1,SSZ(3)
      ENTRY=-0.01  *C00217(I00002)*C00036(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=0.01  *C00217(I00002)*C00034(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01074')
      RETURN
      END
      SUBROUTINE S01076(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*(C00058(I00001,I00002)+
     *  C00059(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01076')
      RETURN
      END
      SUBROUTINE S01077(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00099,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(2)
      ENTRY=0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*C00099(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01077')
      RETURN
      END
      SUBROUTINE S01078(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00070,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(9)
      ENTRY=-0.01  *C00217(I00002)*C00070(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 4 I00001=1,SSZ(6)
      ENTRY=-0.01  *C00217(I00002)*C00045(SSMP(SSMPST(7)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01078')
      RETURN
      END
      SUBROUTINE S01079(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00053,C00054,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(22),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfd"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01079')
      RETURN
      END
      SUBROUTINE S01080(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=0.01  *C00217(I00002)*C00031(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01080')
      RETURN
      END
      SUBROUTINE S01081(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       29)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*C00078(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(29),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01081')
      RETURN
      END
      SUBROUTINE S01082(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00072,C00074,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*C00072(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*C00074(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01082')
      RETURN
      END
      SUBROUTINE S01083(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00292,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00292(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00292(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01083')
      RETURN
      END
      SUBROUTINE S01087(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "DVCO2TRA"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'DVCO2TRA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       59)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*100.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(59),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(59),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "DVCO2TRA"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01087')
      RETURN
      END
      SUBROUTINE S01089(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pft"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pft',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*C00076(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pft"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01089')
      RETURN
      END
      SUBROUTINE S01090(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00068,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(7)
      DO 3 I00001=1,SSZ(6)
      ENTRY=-0.01  *C00217(I00002)*C00068(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00004=1,SSZ(7)
      DO 5 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01090')
      RETURN
      END
      SUBROUTINE S01091(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ams',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       80)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*C00032(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(80),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(80),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01091')
      RETURN
      END
      SUBROUTINE S01095(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      DO 2 I00001=1,SSZ(17)
      ENTRY=-0.01  *C00217(I00002)*C00102(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01095')
      RETURN
      END
      SUBROUTINE S01096(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aosec"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'aosec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       87)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-0.01  *C00217(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "aosec"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01096')
      RETURN
      END
      SUBROUTINE S01098(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aoall"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'aoall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       89)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-0.01  *C00217(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(7)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(89),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(89),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "aoall"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01098')
      RETURN
      END
      SUBROUTINE S01099(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00217,C00330,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00330(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(2)
      ENTRY=C00330(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
      DO 5 I00003=1,SSZ(1)
      DO 4 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*C00034(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01099')
      RETURN
      END
      SUBROUTINE S01100(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      DO 3 I00001=1,SSZ(2)
      ENTRY=0.01  *C00217(I00002)*C00034(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)
      DO 5 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*C00034(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01100')
      RETURN
      END
      SUBROUTINE S01101(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00344,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00344(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(3)
      ENTRY=C00344(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01101')
      RETURN
      END
      SUBROUTINE S01105(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00217,C00218,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00217(SSZ(1))
      REAL C00218(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pt"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pt',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      115)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(3)
      ENTRY=0.01  *C00217(I00002)*C00218(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(115),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(115),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pt"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01105')
      RETURN
      END
      SUBROUTINE S01106(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00167,C00170,C00200,C00201,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00167(SSZ(1))
      REAL C00170(SSZ(1))
      REAL C00200(SSZ(1))
      REAL C00201(SSZ(1))
      REAL C00216(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      123)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00201(I00002)
      RS2=C00170(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00216(I00002)*C00200(I00002)*C00167(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(123),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01106')
      RETURN
      END
      SUBROUTINE S01107(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00168,C00171,C00200,C00202,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00168(SSZ(1))
      REAL C00171(SSZ(1))
      REAL C00200(SSZ(1))
      REAL C00202(SSZ(1))
      REAL C00216(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      124)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00202(I00002)
      RS2=C00171(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00216(I00002)*C00200(I00002)*C00168(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(124),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(124),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01107')
      RETURN
      END
      SUBROUTINE S01108(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00169,C00172,C00200,C00203,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00169(SSZ(1))
      REAL C00172(SSZ(1))
      REAL C00200(SSZ(1))
      REAL C00203(SSZ(1))
      REAL C00216(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      125)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00203(I00002)
      RS2=C00172(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00216(I00002)*C00200(I00002)*C00169(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(125),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(125),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "EV_DECOMPOSITION"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01108')
      RETURN
      END
      SUBROUTINE M00025(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PCONSEXPEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(123),ECHO1,
     *  ROWBF(176),COLBF(123),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(190),ECHO1,
     *  ROWBF(176),COLBF(190),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(191),ECHO1,
     *  ROWBF(176),COLBF(191),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(195),ECHO1,
     *  ROWBF(176),COLBF(195),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(196),ECHO1,
     *  ROWBF(176),COLBF(196),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GOVCONSEXPEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(124),ECHO1,
     *  ROWBF(177),COLBF(124),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(190),ECHO1,
     *  ROWBF(177),COLBF(190),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(195),ECHO1,
     *  ROWBF(177),COLBF(195),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(197),ECHO1,
     *  ROWBF(177),COLBF(197),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'SAVINGEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(125),ECHO1,
     *  ROWBF(178),COLBF(125),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(190),ECHO1,
     *  ROWBF(178),COLBF(190),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(195),ECHO1,
     *  ROWBF(178),COLBF(195),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(199),ECHO1,
     *  ROWBF(178),COLBF(199),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'SAVEUEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(194),ECHO1,
     *  ROWBF(179),COLBF(194),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(199),ECHO1,
     *  ROWBF(179),COLBF(199),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'INCOME_EQUIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01061(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01062(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00167,C00201,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01063(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00168,C00202,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01064(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(125),KZC,DOEQ,STRHS,STRHNZ,
     *  C00169,C00203,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(138),ECHO1,
     *  ROWBF(180),COLBF(138),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(140),ECHO1,
     *  ROWBF(180),COLBF(140),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01067(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(195),KZC,DOEQ,STRHS,STRHNZ,
     *  C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EVREG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01068(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(195),KZC,DOEQ,STRHS,STRHNZ,
     *  C00200,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(201),ECHO1,
     *  ROWBF(181),COLBF(201),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EVWLD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(201),ECHO1,
     *  ROWBF(182),COLBF(201),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(202),ECHO1,
     *  ROWBF(182),COLBF(202),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EV_DECOMPOSITION',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01072(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(1),KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01073(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00064,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01074(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00036,C00217,C00329,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(183),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00291,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01076(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01077(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00099,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01078(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00070,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01079(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  C00053,C00054,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01080(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01081(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(29),KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01082(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00072,C00074,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01083(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00292,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(183),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00270,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(183),COLBF(49),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00250,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(52),ECHO1,
     *  ROWBF(183),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00271,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01087(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(59),KZC,DOEQ,STRHS,STRHNZ,
     *  C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(70),ECHO1,
     *  ROWBF(183),COLBF(70),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00272,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01089(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01090(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00068,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01091(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(80),KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(82),ECHO1,
     *  ROWBF(183),COLBF(82),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(17),SSZ(1),1,1,1,1,1,C00308,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(83),ECHO1,
     *  ROWBF(183),COLBF(83),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00309,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(84),ECHO1,
     *  ROWBF(183),COLBF(84),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00310,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01095(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01096(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(88),ECHO1,
     *  ROWBF(183),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00300,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01098(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01099(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00217,C00330,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01100(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01101(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00344,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(183),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00345,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(110),ECHO1,
     *  ROWBF(183),COLBF(110),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),SSZ(1),1,1,1,1,1,C00346,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(183),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00347,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01105(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(115),KZC,DOEQ,STRHS,STRHNZ,
     *  C00217,C00218,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01106(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00167,C00170,C00200,C00201,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01107(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00168,C00171,C00200,C00202,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01108(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(125),KZC,DOEQ,STRHS,STRHNZ,
     *  C00169,C00172,C00200,C00203,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(203),ECHO1,
     *  ROWBF(183),COLBF(203),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00025')
      RETURN
      END
      SUBROUTINE S01113(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00084,C00148,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00084(SSZ(1))
      REAL C00148(SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxwwld"',
     *  ' in equation "CONT_EV_CO2TR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxwwld',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      168)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00217(I00002)*0.01  *(C00148(I00002)-C00084(I00002))*
     *  C00043(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(168),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(168),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxwwld"',
     *  ' in equation "CONT_EV_CO2TR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01113')
      RETURN
      END
      SUBROUTINE S01115(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00167,C00170,C00200,C00201,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00167(SSZ(1))
      REAL C00170(SSZ(1))
      REAL C00200(SSZ(1))
      REAL C00201(SSZ(1))
      REAL C00216(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      123)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00201(I00002)
      RS2=C00170(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00216(I00002)*C00200(I00002)*C00167(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(123),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01115')
      RETURN
      END
      SUBROUTINE S01116(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00168,C00171,C00200,C00202,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00168(SSZ(1))
      REAL C00171(SSZ(1))
      REAL C00200(SSZ(1))
      REAL C00202(SSZ(1))
      REAL C00216(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      124)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00202(I00002)
      RS2=C00171(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00216(I00002)*C00200(I00002)*C00168(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(124),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(124),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01116')
      RETURN
      END
      SUBROUTINE S01117(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00169,C00172,C00200,C00203,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00169(SSZ(1))
      REAL C00172(SSZ(1))
      REAL C00200(SSZ(1))
      REAL C00203(SSZ(1))
      REAL C00216(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      125)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=C00203(I00002)
      RS2=C00172(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00216(I00002)*C00200(I00002)*C00169(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(125),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(125),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "CNT_WEV_dpar"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01117')
      RETURN
      END
      SUBROUTINE S01119(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00200,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00200(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_pop"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-0.01  *C00200(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(187),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_pop"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01119')
      RETURN
      END
      SUBROUTINE S01121(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*C00070(SSMP(SSMPST(7)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(212),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01121')
      RETURN
      END
      SUBROUTINE S01123(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-0.01  *C00217(I00002)*C00068(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(212),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01123')
      RETURN
      END
      SUBROUTINE S01124(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'CNTalleffir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      232)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(5)-1+I00001)+SSZ(8)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(232),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(212),COLBF(232),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_E"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01124')
      RETURN
      END
      SUBROUTINE S01125(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00064,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgd"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*(C00063(I00001,I00002)+
     *  C00064(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qgd"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01125')
      RETURN
      END
      SUBROUTINE S01126(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00065,C00066,C00076,C00086,C00090,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*(-1.0+C00076(I00001))*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-0.01  *C00217(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*C00048(I00011,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00090(I00011,I00002))*C00086(I00011,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00011))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01126')
      RETURN
      END
      SUBROUTINE S01127(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00065,C00066,C00088,C00090,C00217,C00298,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00298(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00298(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
      DO 4 I00011=1,SSZ(2)
      RS1=-0.01  *C00217(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*C00048(I00011,I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00090(I00011,I00002)*C00088(I00011,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01127')
      RETURN
      END
      SUBROUTINE S01128(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpd"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*(C00058(I00001,I00002)+
     *  C00059(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qpd"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01128')
      RETURN
      END
      SUBROUTINE S01129(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00099,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*C00099(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01129')
      RETURN
      END
      SUBROUTINE S01130(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*C00070(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01130')
      RETURN
      END
      SUBROUTINE S01131(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00053,C00054,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfd"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-0.01  *C00217(I00002)*(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(22),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qfd"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01131')
      RETURN
      END
      SUBROUTINE S01132(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00072,C00074,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 4 I00003=1,SSZ(1)
      ENTRY=-0.01  *C00217(I00002)*C00072(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    4 CONTINUE
      DO 5 I00003=1,SSZ(1)
      ENTRY=-0.01  *C00217(I00002)*C00074(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01132')
      RETURN
      END
      SUBROUTINE S01133(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00299,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00299(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00299(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01133')
      RETURN
      END
      SUBROUTINE S01134(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00095,C00217,C00257,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00257(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*(-1.0+C00095(I00001,I00002))+
     *  C00257(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01134')
      RETURN
      END
      SUBROUTINE S01135(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ug"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ug',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       49)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(49),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(49),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ug"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01135')
      RETURN
      END
      SUBROUTINE S01136(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00095,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yp"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       52)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00095(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(52),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(52),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "yp"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01136')
      RETURN
      END
      SUBROUTINE S01137(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00096,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 4 I00008=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00096(I00001,I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00008+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF
      END IF
    4 CONTINUE
      ENTRY=-0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).LT.RWN) THEN
          NZ=NZ+1
          ENT(NZ)=ENTRY
          ICN(NZ)=COLUMN
          LRW(COLUMN)=RWN
          ADR(COLUMN)=NZ
         ELSE
          ENT(ADR(COLUMN))=ENT(ADR(COLUMN))+ENTRY
         END IF
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01137')
      RETURN
      END
      SUBROUTINE S01138(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pft"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pft',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       75)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-0.01  *C00217(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*C00076(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(75),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(75),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pft"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01138')
      RETURN
      END
      SUBROUTINE S01139(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       78)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      ENTRY=-0.01  *C00217(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(17)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(78),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(78),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01139')
      RETURN
      END
      SUBROUTINE S01140(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'CNTalleffir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      232)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(6)-1+I00001)+SSZ(8)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(232),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(213),COLBF(232),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_T"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01140')
      RETURN
      END
      SUBROUTINE S01141(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "psave"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'psave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        1)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=0.01  *C00217(I00002)*C00009(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(1),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(215),COLBF(1),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "psave"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01141')
      RETURN
      END
      SUBROUTINE S01142(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       29)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*C00078(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(215),COLBF(29),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01142')
      RETURN
      END
      SUBROUTINE S01143(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00078,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00078(SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxwwld"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxwwld',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      168)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*(-C00078(I00002)+C00009(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(168),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(215),COLBF(168),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pxwwld"',
     *  ' in equation "CNT_EV_cgdsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01143')
      RETURN
      END
      SUBROUTINE S01145(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(6)
      ENTRY=-0.01  *C00217(I00002)*C00045(SSMP(SSMPST(7)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(216),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01145')
      RETURN
      END
      SUBROUTINE S01146(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=0.01  *C00217(I00002)*C00031(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(216),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01146')
      RETURN
      END
      SUBROUTINE S01147(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00001=1,SSZ(6)
      RS1=RS1-C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE
      ENTRY=-0.01  *C00217(I00002)*(RS1+C00031(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(216),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01147')
      RETURN
      END
      SUBROUTINE S01149(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*C00045(SSMP(SSMPST(7)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(217),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01149')
      RETURN
      END
      SUBROUTINE S01150(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(6)
      RWN=RWN+1
      ENTRY=0.01  *C00217(I00002)*C00045(SSMP(SSMPST(7)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(217),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01150')
      RETURN
      END
      SUBROUTINE S01152(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ams',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       80)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*C00032(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(80),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(218),COLBF(80),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01152')
      RETURN
      END
      SUBROUTINE S01156(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      DO 2 I00001=1,SSZ(17)
      ENTRY=-0.01  *C00217(I00002)*C00102(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(218),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01156')
      RETURN
      END
      SUBROUTINE S01157(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aosec"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'aosec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       87)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-0.01  *C00217(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(218),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "aosec"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01157')
      RETURN
      END
      SUBROUTINE S01159(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aoall"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'aoall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       89)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-0.01  *C00217(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(7)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(89),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(218),COLBF(89),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "aoall"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01159')
      RETURN
      END
      SUBROUTINE S01160(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00344,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00344(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(3)
      ENTRY=C00344(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(218),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "CONT_EV_techr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01160')
      RETURN
      END
      SUBROUTINE M00026(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'WORLDEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(203),ECHO1,
     *  ROWBF(184),COLBF(203),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(204),ECHO1,
     *  ROWBF(184),COLBF(204),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_CO2TR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(59),ECHO1,
     *  ROWBF(185),COLBF(59),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00217,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01113(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(168),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00084,C00148,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(205),ECHO1,
     *  ROWBF(185),COLBF(205),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CNT_WEV_dpar',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01115(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00167,C00170,C00200,C00201,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01116(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00168,C00171,C00200,C00202,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01117(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(125),KZC,DOEQ,STRHS,STRHNZ,
     *  C00169,C00172,C00200,C00203,C00216,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(206),ECHO1,
     *  ROWBF(186),COLBF(206),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01119(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00200,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(207),ECHO1,
     *  ROWBF(187),COLBF(207),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_alleffir_E',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01121(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(212),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(1),1,1,1,1,1,C00317,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01123(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01124(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(232),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_alleffir_T',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01125(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00064,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01126(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00065,C00066,C00076,C00086,C00090,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01127(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00049,C00065,C00066,C00088,C00090,C00217,C00298,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01128(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01129(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00099,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01130(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01131(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  C00053,C00054,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01132(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00072,C00074,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01133(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00299,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01134(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00095,C00217,C00257,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01135(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(49),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01136(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(52),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00095,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01137(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00096,C00217,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01138(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(75),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01139(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01140(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(232),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CNT_EV_cgdsr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01141(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(1),KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01142(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(29),KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01143(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(168),KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00078,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(234),ECHO1,
     *  ROWBF(215),COLBF(234),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_endwr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01145(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01146(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01147(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(235),ECHO1,
     *  ROWBF(216),COLBF(235),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_endwir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01149(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01150(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(236),ECHO1,
     *  ROWBF(217),COLBF(236),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_techr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01152(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(80),KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(82),ECHO1,
     *  ROWBF(218),COLBF(82),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(17),SSZ(1),1,1,1,1,1,C00308,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(83),ECHO1,
     *  ROWBF(218),COLBF(83),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00309,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(84),ECHO1,
     *  ROWBF(218),COLBF(84),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00310,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01156(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01157(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(88),ECHO1,
     *  ROWBF(218),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00301,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01159(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01160(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00344,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(218),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00345,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(110),ECHO1,
     *  ROWBF(218),COLBF(110),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),SSZ(1),1,1,1,1,1,C00346,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(218),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00347,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(237),ECHO1,
     *  ROWBF(218),COLBF(237),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00026')
      RETURN
      END
      SUBROUTINE S01165(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aosec"',
     *  ' in equation "CONT_EV_tech_aor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'aosec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       87)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-0.01  *C00217(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(219),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "aosec"',
     *  ' in equation "CONT_EV_tech_aor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01165')
      RETURN
      END
      SUBROUTINE S01167(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aoall"',
     *  ' in equation "CONT_EV_tech_aor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'aoall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       89)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(7)
      ENTRY=-0.01  *C00217(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(7)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(89),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(219),COLBF(89),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "aoall"',
     *  ' in equation "CONT_EV_tech_aor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01167')
      RETURN
      END
      SUBROUTINE S01172(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "CONT_EV_tech_afr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       85)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(7)
      DO 2 I00001=1,SSZ(17)
      ENTRY=-0.01  *C00217(I00002)*C00102(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(17)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(221),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "CONT_EV_tech_afr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01172')
      RETURN
      END
      SUBROUTINE S01174(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00348,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00348(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "CONT_EV_tech_atrr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(3)
      ENTRY=C00348(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(223),COLBF(108),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "CONT_EV_tech_atrr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01174')
      RETURN
      END
      SUBROUTINE S01179(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_tech_amsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ams',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       80)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      ENTRY=-0.01  *C00217(I00002)*C00032(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(80),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(225),COLBF(80),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_tech_amsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01179')
      RETURN
      END
      SUBROUTINE S01181(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_kbr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=0.01  *C00217(I00002)*C00031(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_kbr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01181')
      RETURN
      END
      SUBROUTINE S01182(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00217(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_kbr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-0.01  *C00217(I00002)*C00031(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_kbr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01182')
      RETURN
      END
      SUBROUTINE S01184(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00334,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00334(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00334(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(228),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01184')
      RETURN
      END
      SUBROUTINE S01185(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00335,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00335(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=C00335(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(228),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01185')
      RETURN
      END
      SUBROUTINE S01186(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00224,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00224(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00224(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(228),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01186')
      RETURN
      END
      SUBROUTINE S01187(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "px_ir"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'px_ir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      247)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(247),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(228),COLBF(247),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "px_ir"',
     *  ' in equation "EXPPRICE_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01187')
      RETURN
      END
      SUBROUTINE S01188(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00336,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00336(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00336(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01188')
      RETURN
      END
      SUBROUTINE S01189(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00337,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00337(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00337(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01189')
      RETURN
      END
      SUBROUTINE S01190(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00224,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00224(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00224(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01190')
      RETURN
      END
      SUBROUTINE S01191(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "px_ir"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'px_ir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      247)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(247),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),COLBF(247),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "px_ir"',
     *  ' in equation "EXPPRICE_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01191')
      RETURN
      END
      SUBROUTINE S01192(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00226(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=-C00226(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01192')
      RETURN
      END
      SUBROUTINE S01193(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00226(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00226(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01193')
      RETURN
      END
      SUBROUTINE S01194(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00226(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00226(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01194')
      RETURN
      END
      SUBROUTINE S01196(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00003
      INTEGER I00005
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm_ir"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm_ir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      248)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00005=1,SSZ(3)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(248),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),COLBF(248),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm_ir"',
     *  ' in equation "IMPPRICE1_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01196')
      RETURN
      END
      SUBROUTINE S01197(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00226(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=-C00226(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01197')
      RETURN
      END
      SUBROUTINE S01198(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00226(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tx',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      101)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00226(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(101),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(101),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01198')
      RETURN
      END
      SUBROUTINE S01199(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00226(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'txs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      102)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00226(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(102),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(102),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01199')
      RETURN
      END
      SUBROUTINE S01200(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm_ir"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm_ir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      248)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(248),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(248),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "pm_ir"',
     *  ' in equation "IMPPRICE1_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01200')
      RETURN
      END
      SUBROUTINE S01205(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00219,C00223,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00219(SSZ(2),SSZ(1))
      REAL C00223(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "px_i"',
     *  ' in equation "c1_irEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'px_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      249)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=-(C00219(I00001,I00002)-C00223(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(249),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(249),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "px_i"',
     *  ' in equation "c1_irEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01205')
      RETURN
      END
      SUBROUTINE S01206(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00219,C00223,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00219(SSZ(2),SSZ(1))
      REAL C00223(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "px_"',
     *  ' in equation "c1_irEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'px_',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      250)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(2)
      RWN=RWN+1
      ENTRY=C00219(I00001,I00002)-C00223(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(250),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(250),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "px_"',
     *  ' in equation "c1_irEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01206')
      RETURN
      END
      SUBROUTINE M00027(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_tech_aor',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01165(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(88),ECHO1,
     *  ROWBF(219),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00301,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01167(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(238),ECHO1,
     *  ROWBF(219),COLBF(238),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_tech_afr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(82),ECHO1,
     *  ROWBF(221),COLBF(82),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(17),SSZ(1),1,1,1,1,1,C00311,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(83),ECHO1,
     *  ROWBF(221),COLBF(83),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00312,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(84),ECHO1,
     *  ROWBF(221),COLBF(84),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00313,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01172(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(240),ECHO1,
     *  ROWBF(221),COLBF(240),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_tech_atrr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01174(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00348,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(223),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00349,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(110),ECHO1,
     *  ROWBF(223),COLBF(110),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),SSZ(1),1,1,1,1,1,C00350,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(111),ECHO1,
     *  ROWBF(223),COLBF(111),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00351,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(242),ECHO1,
     *  ROWBF(223),COLBF(242),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_tech_amsr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01179(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(80),KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(244),ECHO1,
     *  ROWBF(225),COLBF(244),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_kbr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01181(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01182(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00217,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(246),ECHO1,
     *  ROWBF(227),COLBF(246),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EXPPRICE_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01184(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00334,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01185(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00335,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01186(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00224,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01187(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(247),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EXPPRICE_NMRG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01188(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00336,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01189(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00337,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01190(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00224,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01191(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(247),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'IMPPRICE1_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01192(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01193(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01194(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(230),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00227,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01196(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(248),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'IMPPRICE1_NMRG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01197(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01198(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01199(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01200(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(248),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'WRLDPRICEi',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(247),ECHO1,
     *  ROWBF(232),COLBF(247),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00228,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(249),ECHO1,
     *  ROWBF(232),COLBF(249),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'WRLDPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(249),ECHO1,
     *  ROWBF(233),COLBF(249),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00229,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(250),ECHO1,
     *  ROWBF(233),COLBF(250),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c1_irEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01205(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(249),KZC,DOEQ,STRHS,STRHNZ,
     *  C00219,C00223,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01206(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(250),KZC,DOEQ,STRHS,STRHNZ,
     *  C00219,C00223,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(251),ECHO1,
     *  ROWBF(234),COLBF(251),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c2_irEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(247),ECHO1,
     *  ROWBF(235),COLBF(247),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00219,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(249),ECHO1,
     *  ROWBF(235),COLBF(249),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00219,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(252),ECHO1,
     *  ROWBF(235),COLBF(252),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c3_irEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(248),ECHO1,
     *  ROWBF(236),COLBF(248),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00223,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(249),ECHO1,
     *  ROWBF(236),COLBF(249),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00223,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(253),ECHO1,
     *  ROWBF(236),COLBF(253),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c1_rEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(251),ECHO1,
     *  ROWBF(237),COLBF(251),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(254),ECHO1,
     *  ROWBF(237),COLBF(254),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00027')
      RETURN
      END
      SUBROUTINE M00028(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c2_rEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(252),ECHO1,
     *  ROWBF(238),COLBF(252),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(255),ECHO1,
     *  ROWBF(238),COLBF(255),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c3_rEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(253),ECHO1,
     *  ROWBF(239),COLBF(253),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(256),ECHO1,
     *  ROWBF(239),COLBF(256),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOT2eq',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(254),ECHO1,
     *  ROWBF(240),COLBF(254),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(255),ECHO1,
     *  ROWBF(240),COLBF(255),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(256),ECHO1,
     *  ROWBF(240),COLBF(256),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(257),ECHO1,
     *  ROWBF(240),COLBF(257),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00028')
      RETURN
      END
      SUBROUTINE S01224(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00032,C00217,
     *  V00080,V00245,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00080(SSZ(2),SSZ(1),SSZ(1))
      REAL V00245(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTtech_amsirs"',
     *  ' using equation "CONT_EV_tech_amsirs"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      V00245(I00001,I00002,I00003)=0.01  *C00217(I00002)*
     *  C00032(I00001,I00002,I00003)*V00080(I00001,I00002,I00003)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTtech_amsirs"',
     *  ' using equation "CONT_EV_tech_amsirs"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01224')
      RETURN
      END
      SUBROUTINE S01225(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00135,C00217,
     *  V00108,V00109,V00110,V00111,V00243,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00108(SSZ(2))
      REAL V00109(SSZ(2))
      REAL V00110(SSZ(1))
      REAL V00111(SSZ(1))
      REAL V00243(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTtech_afmfdsd"',
     *  ' using equation "CONT_EV_tech_afmfdsd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00003=1,SSZ(1)
      DO 3 I00002=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      DO 1 I00005=1,SSZ(3)
      V00243(I00005,I00001,I00002,I00003)=-(-0.01  *C00217(I00003)*
     *  C00135(I00005,I00001,I00002,I00003)*V00108(SSMP(SSMPST(1)-1+
     *  I00005))-0.01  *C00217(I00003)*
     *  C00135(I00005,I00001,I00002,I00003)*V00109(I00001)-0.01  *
     *  C00217(I00003)*C00135(I00005,I00001,I00002,I00003)*
     *  V00110(I00002)-0.01  *C00217(I00003)*
     *  C00135(I00005,I00001,I00002,I00003)*V00111(I00003))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTtech_afmfdsd"',
     *  ' using equation "CONT_EV_tech_afmfdsd"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01225')
      RETURN
      END
      SUBROUTINE S01226(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00102,C00217,
     *  V00082,V00083,V00084,V00085,V00241,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00102(SSZ(17),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00082(SSZ(17))
      REAL V00083(SSZ(7))
      REAL V00084(SSZ(1))
      REAL V00085(SSZ(17),SSZ(7),SSZ(1))
      REAL V00241(SSZ(17),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTtech_afijr"',
     *  ' using equation "CONT_EV_tech_afijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(17)
      V00241(I00001,I00004,I00002)=-(-0.01  *C00217(I00002)*
     *  C00102(I00001,I00004,I00002)*V00082(I00001)-0.01  *
     *  C00217(I00002)*C00102(I00001,I00004,I00002)*V00083(I00004)-
     *  0.01  *C00217(I00002)*C00102(I00001,I00004,I00002)*
     *  V00084(I00002)-0.01  *C00217(I00002)*
     *  C00102(I00001,I00004,I00002)*V00085(I00001,I00004,I00002))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTtech_afijr"',
     *  ' using equation "CONT_EV_tech_afijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01226')
      RETURN
      END
      SUBROUTINE S01227(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00045,C00217,
     *  V00087,V00088,V00089,V00239,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00087(SSZ(7))
      REAL V00088(SSZ(1))
      REAL V00089(SSZ(7),SSZ(1))
      REAL V00239(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTtech_aoir"',
     *  ' using equation "CONT_EV_tech_aoir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(7)
      V00239(I00001,I00002)=-(-0.01  *C00217(I00002)*
     *  C00045(SSMP(SSMPST(9)-1+I00001),I00002)*V00087(I00001)-0.01  *
     *  C00217(I00002)*C00045(SSMP(SSMPST(9)-1+I00001),I00002)*
     *  V00088(I00002)-0.01  *C00217(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)*V00089(I00001,I00002))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTtech_aoir"',
     *  ' using equation "CONT_EV_tech_aoir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01227')
      RETURN
      END
      SUBROUTINE S01228(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00034,C00036,C00217,C00218,C00331,C00332,C00333,
     *  V00005,V00101,V00102,V00115,V00168,V00233,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00218(SSZ(3),SSZ(1))
      REAL C00331(SSZ(2),SSZ(1))
      REAL C00332(SSZ(2),SSZ(1))
      REAL C00333(SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00101(SSZ(2),SSZ(1))
      REAL V00102(SSZ(2),SSZ(1),SSZ(1))
      REAL V00115(SSZ(3))
      REAL V00168(1)
      REAL V00233(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTtotr"',
     *  ' using equation "CONT_EV_totr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00331(I00001,I00002)*V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)
    2 CONTINUE
      RS2=0.0
      DO 3 I00005=1,SSZ(3)
      RS2=RS2-0.01  *C00217(I00002)*C00036(I00005,I00002)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005))),I00002)
    3 CONTINUE
      RS3=0.0
      DO 5 I00003=1,SSZ(1)
      RS4=0.0
      DO 4 I00001=1,SSZ(2)
      RS4=RS4+0.01  *C00217(I00002)*C00034(I00001,I00003,I00002)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00003)
    4 CONTINUE
      RS3=RS3+RS4
    5 CONTINUE
      RS5=0.0
      DO 6 I00001=1,SSZ(2)
      RS5=RS5+C00332(I00001,I00002)*V00101(I00001,I00002)
    6 CONTINUE
      RS6=0.0
      DO 8 I00003=1,SSZ(1)
      RS7=0.0
      DO 7 I00001=1,SSZ(2)
      RS7=RS7-0.01  *C00217(I00002)*C00034(I00001,I00003,I00002)*
     *  V00101(I00001,I00003)
    7 CONTINUE
      RS6=RS6+RS7
    8 CONTINUE
      RS8=0.0
      DO 10 I00003=1,SSZ(1)
      RS9=0.0
      DO 9 I00001=1,SSZ(2)
      RS9=RS9+0.01  *C00217(I00002)*C00034(I00001,I00002,I00003)*
     *  V00102(I00001,I00002,I00003)
    9 CONTINUE
      RS8=RS8+RS9
   10 CONTINUE
      RS10=0.0
      DO 12 I00003=1,SSZ(1)
      RS11=0.0
      DO 11 I00001=1,SSZ(2)
      RS11=RS11-0.01  *C00217(I00002)*C00034(I00001,I00003,I00002)*
     *  V00102(I00001,I00003,I00002)
   11 CONTINUE
      RS10=RS10+RS11
   12 CONTINUE
      RS12=0.0
      DO 13 I00005=1,SSZ(3)
      RS12=RS12+0.01  *C00217(I00002)*C00218(I00005,I00002)*
     *  V00115(I00005)
   13 CONTINUE
      V00233(I00002)=-(RS1+RS2+RS3+RS5+RS6+RS8+RS10+RS12+C00333(I00002)*
     *  V00168(1))
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTtotr"',
     *  ' using equation "CONT_EV_totr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01228')
      RETURN
      END
      SUBROUTINE S01229(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00053,C00054,C00055,C00056,C00058,C00059,C00060,
     *  C00061,C00063,C00064,C00068,C00070,C00072,C00074,C00076,
     *  C00099,C00217,C00246,C00250,C00271,C00272,C00277,C00291,
     *  C00292,
     *  V00004,V00005,V00009,V00012,V00016,V00018,V00022,V00031,
     *  V00041,V00044,V00049,V00052,V00070,V00075,V00078,V00231,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15,RS16,RS17,RS18,RS19
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00246(SSZ(2),SSZ(1))
      REAL C00250(SSZ(1))
      REAL C00271(SSZ(1))
      REAL C00272(SSZ(2),SSZ(1))
      REAL C00277(SSZ(1))
      REAL C00291(SSZ(2),SSZ(1))
      REAL C00292(SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL V00018(SSZ(9),SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00044(SSZ(1))
      REAL V00049(SSZ(1))
      REAL V00052(SSZ(1))
      REAL V00070(SSZ(2),SSZ(1))
      REAL V00075(SSZ(2),SSZ(7),SSZ(1))
      REAL V00078(SSZ(17),SSZ(7),SSZ(1))
      REAL V00231(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTalleffr"',
     *  ' using equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1-0.01  *C00217(I00002)*(C00063(I00001,I00002)+
     *  C00064(I00001,I00002))*V00004(I00001,I00002)
    2 CONTINUE
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00246(I00001,I00002)*V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)
    3 CONTINUE
      RS3=0.0
      DO 4 I00001=1,SSZ(2)
      RS3=RS3+C00291(I00001,I00002)*V00009(I00001,I00002)
    4 CONTINUE
      RS4=0.0
      DO 5 I00001=1,SSZ(2)
      RS4=RS4-0.01  *C00217(I00002)*(C00058(I00001,I00002)+
     *  C00059(I00001,I00002))*V00012(I00001,I00002)
    5 CONTINUE
      RS5=0.0
      DO 6 I00001=1,SSZ(2)
      RS5=RS5+0.01  *C00217(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*C00099(I00001,I00002)*
     *  V00016(I00001,I00002)
    6 CONTINUE
      RS6=0.0
      DO 7 I00001=1,SSZ(9)
      RS6=RS6-0.01  *C00217(I00002)*C00070(I00001,I00002)*
     *  V00018(I00001,I00002)
    7 CONTINUE
      RS7=0.0
      DO 9 I00004=1,SSZ(7)
      RS8=0.0
      DO 8 I00001=1,SSZ(2)
      RS8=RS8-0.01  *C00217(I00002)*(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))*V00022(I00001,I00004,I00002)
    8 CONTINUE
      RS7=RS7+RS8
    9 CONTINUE
      RS9=0.0
      DO 11 I00003=1,SSZ(1)
      RS10=0.0
      DO 10 I00001=1,SSZ(2)
      RS10=RS10-0.01  *C00217(I00002)*C00072(I00001,I00002,I00003)*
     *  V00031(I00001,I00002,I00003)
   10 CONTINUE
      RS9=RS9+RS10
   11 CONTINUE
      RS11=0.0
      DO 13 I00003=1,SSZ(1)
      RS12=0.0
      DO 12 I00001=1,SSZ(2)
      RS12=RS12-0.01  *C00217(I00002)*C00074(I00001,I00003,I00002)*
     *  V00031(I00001,I00003,I00002)
   12 CONTINUE
      RS11=RS11+RS12
   13 CONTINUE
      RS13=0.0
      DO 14 I00008=1,SSZ(2)
      RS13=RS13+C00272(I00008,I00002)*V00070(I00008,I00002)
   14 CONTINUE
      RS14=0.0
      DO 16 I00004=1,SSZ(7)
      RS15=0.0
      DO 15 I00001=1,SSZ(2)
      RS15=RS15-0.01  *C00217(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*C00076(I00001)*
     *  V00075(I00001,I00004,I00002)
   15 CONTINUE
      RS14=RS14+RS15
   16 CONTINUE
      RS16=0.0
      DO 18 I00004=1,SSZ(7)
      RS17=0.0
      DO 17 I00001=1,SSZ(6)
      RS17=RS17-0.01  *C00217(I00002)*C00068(I00001,I00004,I00002)*
     *  V00078(SSMP(SSMPST(15)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00004,I00002)
   17 CONTINUE
      RS16=RS16+RS17
   18 CONTINUE
      RS18=0.0
      DO 20 I00004=1,SSZ(7)
      RS19=0.0
      DO 19 I00001=1,SSZ(2)
      RS19=RS19-0.01  *C00217(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*V00078(SSMP(SSMPST(15)-1+
     *  SSMP(SSMPST(6)-1+I00001)),I00004,I00002)
   19 CONTINUE
      RS18=RS18+RS19
   20 CONTINUE
      V00231(I00002)=-(RS1+RS2+RS3+RS4+RS5+RS6+RS7+RS9+RS11+
     *  C00292(I00002)*V00041(C00008(I00002))+C00277(I00002)*
     *  V00044(I00002)+C00250(I00002)*V00049(I00002)+C00271(I00002)*
     *  V00052(I00002)+RS13+RS14+RS16+RS18)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTalleffr"',
     *  ' using equation "CONT_EV_alleffr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01229')
      RETURN
      END
      SUBROUTINE S01230(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00074,C00217,
     *  V00031,V00044,V00230,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00230(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqimisr"',
     *  ' using equation "CONT_EV_qimisr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      V00230(I00001,I00003,I00002)=C00074(I00001,I00003,I00002)*0.01  *
     *  C00217(I00002)*(V00031(I00001,I00003,I00002)-V00044(I00002))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqimisr"',
     *  ' using equation "CONT_EV_qimisr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01230')
      RETURN
      END
      SUBROUTINE S01231(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00074,C00217,
     *  V00031,V00044,V00229,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00229(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqimr"',
     *  ' using equation "CONT_EV_qimr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2+C00074(I00001,I00003,I00002)*0.01  *C00217(I00002)*
     *  (V00031(I00001,I00003,I00002)-V00044(I00002))
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      V00229(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqimr"',
     *  ' using equation "CONT_EV_qimr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01231')
      RETURN
      END
      SUBROUTINE S01232(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00072,C00217,
     *  V00031,V00044,V00228,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00228(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqxsirs"',
     *  ' using equation "CONT_EV_qxsirs"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      V00228(I00001,I00002,I00003)=C00072(I00001,I00002,I00003)*0.01  *
     *  C00217(I00002)*(V00031(I00001,I00002,I00003)-V00044(I00002))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqxsirs"',
     *  ' using equation "CONT_EV_qxsirs"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01232')
      RETURN
      END
      SUBROUTINE S01233(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00072,C00217,
     *  V00031,V00044,V00227,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00227(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqxsr"',
     *  ' using equation "CONT_EV_qxsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2+C00072(I00001,I00002,I00003)*0.01  *C00217(I00002)*
     *  (V00031(I00001,I00002,I00003)-V00044(I00002))
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      V00227(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqxsr"',
     *  ' using equation "CONT_EV_qxsr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01233')
      RETURN
      END
      SUBROUTINE S01234(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00063,C00064,C00217,
     *  V00004,V00044,V00226,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00226(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqgdir"',
     *  ' using equation "CONT_EV_qgdir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      V00226(I00001,I00002)=(C00063(I00001,I00002)+
     *  C00064(I00001,I00002))*0.01  *C00217(I00002)*
     *  (V00004(I00001,I00002)-V00044(I00002))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqgdir"',
     *  ' using equation "CONT_EV_qgdir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01234')
      RETURN
      END
      SUBROUTINE S01235(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00063,C00064,C00217,
     *  V00004,V00044,V00225,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00225(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqgdr"',
     *  ' using equation "CONT_EV_qgdr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+(C00063(I00001,I00002)+C00064(I00001,I00002))*0.01  *
     *  C00217(I00002)*(V00004(I00001,I00002)-V00044(I00002))
    2 CONTINUE
      V00225(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqgdr"',
     *  ' using equation "CONT_EV_qgdr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01235')
      RETURN
      END
      SUBROUTINE S01236(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00048,C00049,C00065,C00066,C00076,C00086,C00088,
     *  C00090,C00217,C00234,
     *  V00005,V00009,V00041,V00044,V00049,V00224,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00234(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00044(SSZ(1))
      REAL V00049(SSZ(1))
      REAL V00224(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqgmir"',
     *  ' using equation "CONT_EV_qgmir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=-(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00048(I00011,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(1  -C00090(I00011,I00002))*C00086(I00011,I00002)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00011)),I00002)
    3 CONTINUE
      RS5=0.0
      DO 4 I00011=1,SSZ(2)
      RS6=-(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00048(I00011,I00002)
      RS7=C00049(I00002)
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS5=RS5+RS8*C00090(I00011,I00002)*C00088(I00011,I00002)*
     *  V00009(I00011,I00002)
    4 CONTINUE
      RS9=-(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00217(I00002)*(-1.0+C00076(I00001))*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+RS1+
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00217(I00002)*(C00076(I00001)*C00088(I00001,I00002)-(-1.0+
     *  C00076(I00001))*C00090(I00001,I00002)*C00088(I00001,I00002))*
     *  V00009(I00001,I00002)+RS5
      V00224(I00001,I00002)=-(RS9+(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*0.01  *C00217(I00002)*
     *  C00234(I00001,I00002)*V00041(C00008(I00002))-
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00217(I00002)*(1.0-1.0)*V00044(I00002)-(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*0.01  *C00217(I00002)*V00049(I00002))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqgmir"',
     *  ' using equation "CONT_EV_qgmir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01236')
      RETURN
      END
      SUBROUTINE S01237(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00251,C00252,C00253,C00254,C00255,
     *  V00005,V00009,V00041,V00044,V00049,V00223,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00251(SSZ(2),SSZ(1))
      REAL C00252(SSZ(2),SSZ(1))
      REAL C00253(SSZ(1))
      REAL C00254(SSZ(1))
      REAL C00255(SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00044(SSZ(1))
      REAL V00049(SSZ(1))
      REAL V00223(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqgmr"',
     *  ' using equation "CONT_EV_qgmr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00251(I00001,I00002)*V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)
    2 CONTINUE
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+C00252(I00001,I00002)*V00009(I00001,I00002)
    3 CONTINUE
      V00223(I00002)=-(RS1+RS2+C00253(I00002)*V00041(C00008(I00002))+
     *  C00254(I00002)*V00044(I00002)+C00255(I00002)*V00049(I00002))
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqgmr"',
     *  ' using equation "CONT_EV_qgmr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01237')
      RETURN
      END
      SUBROUTINE S01238(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00058,C00059,C00217,
     *  V00012,V00044,V00222,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00222(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqpdir"',
     *  ' using equation "CONT_EV_qpdir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      V00222(I00001,I00002)=(C00058(I00001,I00002)+
     *  C00059(I00001,I00002))*0.01  *C00217(I00002)*
     *  (V00012(I00001,I00002)-V00044(I00002))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqpdir"',
     *  ' using equation "CONT_EV_qpdir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01238')
      RETURN
      END
      SUBROUTINE S01239(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00058,C00059,C00217,
     *  V00012,V00044,V00221,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00221(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqpdr"',
     *  ' using equation "CONT_EV_qpdr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+(C00058(I00001,I00002)+C00059(I00001,I00002))*0.01  *
     *  C00217(I00002)*(V00012(I00001,I00002)-V00044(I00002))
    2 CONTINUE
      V00221(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqpdr"',
     *  ' using equation "CONT_EV_qpdr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01239')
      RETURN
      END
      SUBROUTINE S01240(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00060,C00061,C00076,C00095,C00096,C00099,C00100,
     *  C00217,
     *  V00009,V00016,V00041,V00044,V00052,V00070,V00220,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00044(SSZ(1))
      REAL V00052(SSZ(1))
      REAL V00070(SSZ(2),SSZ(1))
      REAL V00220(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqpmir"',
     *  ' using equation "CONT_EV_qpmir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00076(I00001)*C00099(I00001,I00002)*
     *  V00009(I00001,I00002)+(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*0.01  *C00217(I00002)*C00076(I00001)*
     *  C00099(I00001,I00002)*V00016(I00001,I00002)+
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00076(I00001)*100.0 *C00100(I00001,I00002)*
     *  V00041(C00008(I00002))
      RS2=0.0
      DO 3 I00008=1,SSZ(2)
      RS2=RS2-(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00096(I00001,I00008,I00002)*
     *  V00070(I00008,I00002)
    3 CONTINUE
      V00220(I00001,I00002)=-(RS1-(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*0.01  *C00217(I00002)*(-(-1.0+
     *  C00095(I00001,I00002))-1.0)*V00044(I00002)-
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00095(I00001,I00002)*V00052(I00002)+RS2-
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00076(I00001)*V00070(I00001,I00002))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqpmir"',
     *  ' using equation "CONT_EV_qpmir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01240')
      RETURN
      END
      SUBROUTINE S01241(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00060,C00061,C00076,C00099,C00217,C00273,C00274,
     *  C00275,C00276,
     *  V00009,V00016,V00041,V00044,V00052,V00070,V00219,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00273(SSZ(1))
      REAL C00274(SSZ(1))
      REAL C00275(SSZ(1))
      REAL C00276(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00044(SSZ(1))
      REAL V00052(SSZ(1))
      REAL V00070(SSZ(2),SSZ(1))
      REAL V00219(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqpmr"',
     *  ' using equation "CONT_EV_qpmr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00076(I00001)*C00099(I00001,I00002)*
     *  V00009(I00001,I00002)
    2 CONTINUE
      RS2=0.0
      DO 3 I00001=1,SSZ(2)
      RS2=RS2+(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00217(I00002)*C00076(I00001)*C00099(I00001,I00002)*
     *  V00016(I00001,I00002)
    3 CONTINUE
      RS3=0.0
      DO 4 I00008=1,SSZ(2)
      RS3=RS3+C00276(I00008,I00002)*V00070(I00008,I00002)
    4 CONTINUE
      V00219(I00002)=-(RS1+RS2+C00273(I00002)*V00041(C00008(I00002))+
     *  C00274(I00002)*V00044(I00002)+C00275(I00002)*V00052(I00002)+RS3)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqpmr"',
     *  ' using equation "CONT_EV_qpmr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01241')
      RETURN
      END
      SUBROUTINE S01242(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00053,C00054,C00217,
     *  V00022,V00044,V00218,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00218(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfdijr"',
     *  ' using equation "CONT_EV_qfdijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      V00218(I00001,I00004,I00002)=(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))*0.01  *C00217(I00002)*
     *  (V00022(I00001,I00004,I00002)-V00044(I00002))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqfdijr"',
     *  ' using equation "CONT_EV_qfdijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01242')
      RETURN
      END
      SUBROUTINE S01243(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00053,C00054,C00217,
     *  V00022,V00044,V00217,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00217(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfdir"',
     *  ' using equation "CONT_EV_qfdir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1+(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))*0.01  *C00217(I00002)*
     *  (V00022(I00001,I00004,I00002)-V00044(I00002))
    3 CONTINUE
      V00217(I00001,I00002)=RS1
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqfdir"',
     *  ' using equation "CONT_EV_qfdir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01243')
      RETURN
      END
      SUBROUTINE S01244(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00053,C00054,C00217,
     *  V00022,V00044,V00216,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00216(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfdr"',
     *  ' using equation "CONT_EV_qfdr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS2=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=RS2+(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))*0.01  *C00217(I00002)*
     *  (V00022(I00001,I00004,I00002)-V00044(I00002))
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      V00216(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqfdr"',
     *  ' using equation "CONT_EV_qfdr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01244')
      RETURN
      END
      SUBROUTINE S01245(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00055,C00056,C00076,C00106,C00107,C00217,
     *  V00009,V00041,V00044,V00075,V00078,V00215,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00044(SSZ(1))
      REAL V00075(SSZ(2),SSZ(7),SSZ(1))
      REAL V00078(SSZ(17),SSZ(7),SSZ(1))
      REAL V00215(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfmijr"',
     *  ' using equation "CONT_EV_qfmijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      RS1=(C00055(I00001,I00004,I00002)+C00056(I00001,I00004,I00002))*
     *  0.01  *C00217(I00002)*C00076(I00001)*
     *  C00106(I00001,I00004,I00002)*V00009(I00001,I00002)+
     *  (C00055(I00001,I00004,I00002)+C00056(I00001,I00004,I00002))*
     *  0.01  *C00217(I00002)*C00076(I00001)*100.0 *
     *  C00107(I00001,I00004,I00002)*V00041(C00008(I00002))+
     *  (C00055(I00001,I00004,I00002)+C00056(I00001,I00004,I00002))*
     *  0.01  *C00217(I00002)*V00044(I00002)
      V00215(I00001,I00004,I00002)=-(RS1-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00217(I00002)*
     *  C00076(I00001)*V00075(I00001,I00004,I00002)-
     *  (C00055(I00001,I00004,I00002)+C00056(I00001,I00004,I00002))*
     *  0.01  *C00217(I00002)*V00078(SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+
     *  I00001)),I00004,I00002))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqfmijr"',
     *  ' using equation "CONT_EV_qfmijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01245')
      RETURN
      END
      SUBROUTINE S01246(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00055,C00056,C00076,C00217,C00293,C00296,C00297,
     *  V00009,V00041,V00044,V00075,V00078,V00214,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00217(SSZ(1))
      REAL C00293(SSZ(2),SSZ(1))
      REAL C00296(SSZ(2),SSZ(1))
      REAL C00297(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00044(SSZ(1))
      REAL V00075(SSZ(2),SSZ(7),SSZ(1))
      REAL V00078(SSZ(17),SSZ(7),SSZ(1))
      REAL V00214(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfmir"',
     *  ' using equation "CONT_EV_qfmir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00217(I00002)*
     *  C00076(I00001)*V00075(I00001,I00004,I00002)
    3 CONTINUE
      RS2=0.0
      DO 4 I00004=1,SSZ(7)
      RS2=RS2-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00217(I00002)*
     *  V00078(SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+
     *  I00001)),I00004,I00002)
    4 CONTINUE
      V00214(I00001,I00002)=-(C00293(I00001,I00002)*
     *  V00009(I00001,I00002)+C00296(I00001,I00002)*
     *  V00041(C00008(I00002))+C00297(I00001,I00002)*V00044(I00002)+RS1+
     *  RS2)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqfmir"',
     *  ' using equation "CONT_EV_qfmir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01246')
      RETURN
      END
      SUBROUTINE S01247(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00055,C00056,C00076,C00217,C00293,C00294,C00295,
     *  V00009,V00041,V00044,V00075,V00078,V00213,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00217(SSZ(1))
      REAL C00293(SSZ(2),SSZ(1))
      REAL C00294(SSZ(1))
      REAL C00295(SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00044(SSZ(1))
      REAL V00075(SSZ(2),SSZ(7),SSZ(1))
      REAL V00078(SSZ(17),SSZ(7),SSZ(1))
      REAL V00213(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfmr"',
     *  ' using equation "CONT_EV_qfmr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS1=RS1+C00293(I00001,I00002)*V00009(I00001,I00002)
    2 CONTINUE
      RS2=0.0
      DO 4 I00004=1,SSZ(7)
      RS3=0.0
      DO 3 I00001=1,SSZ(2)
      RS3=RS3-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00217(I00002)*
     *  C00076(I00001)*V00075(I00001,I00004,I00002)
    3 CONTINUE
      RS2=RS2+RS3
    4 CONTINUE
      RS4=0.0
      DO 6 I00004=1,SSZ(7)
      RS5=0.0
      DO 5 I00001=1,SSZ(2)
      RS5=RS5-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00217(I00002)*
     *  V00078(SSMP(SSMPST(15)-1+SSMP(SSMPST(6)-1+
     *  I00001)),I00004,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    6 CONTINUE
      V00213(I00002)=-(RS1+C00294(I00002)*V00041(C00008(I00002))+
     *  C00295(I00002)*V00044(I00002)+RS2+RS4)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqfmr"',
     *  ' using equation "CONT_EV_qfmr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01247')
      RETURN
      END
      SUBROUTINE S01248(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00068,C00217,
     *  V00044,V00078,V00212,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00078(SSZ(17),SSZ(7),SSZ(1))
      REAL V00212(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfeijr"',
     *  ' using equation "CONT_EV_qfeijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(6)
      V00212(I00001,I00004,I00002)=-(C00068(I00001,I00004,I00002)*
     *  0.01  *C00217(I00002)*V00044(I00002)-
     *  C00068(I00001,I00004,I00002)*0.01  *C00217(I00002)*
     *  V00078(SSMP(SSMPST(15)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00004,I00002))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqfeijr"',
     *  ' using equation "CONT_EV_qfeijr"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01248')
      RETURN
      END
      SUBROUTINE M00029(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  CWKUN,
     *  FSTPAS,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c1
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER CWKUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) ERRMES
      LOGICAL FSTPAS
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTtech_amsirs','CONT_EV_tech_amsirs',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01224(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00032,C00217,
     *  V00080,V00245,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTtech_afmfdsd','CONT_EV_tech_afmfdsd',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01225(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00135,C00217,
     *  V00108,V00109,V00110,V00111,V00243,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTtech_afijr','CONT_EV_tech_afijr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01226(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00102,C00217,
     *  V00082,V00083,V00084,V00085,V00241,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTtech_aoir','CONT_EV_tech_aoir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01227(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00045,C00217,
     *  V00087,V00088,V00089,V00239,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTtotr','CONT_EV_totr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01228(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00034,C00036,C00217,C00218,C00331,C00332,C00333,
     *  V00005,V00101,V00102,V00115,V00168,V00233,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTalleffr','CONT_EV_alleffr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01229(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00053,C00054,C00055,C00056,C00058,C00059,C00060,
     *  C00061,C00063,C00064,C00068,C00070,C00072,C00074,C00076,
     *  C00099,C00217,C00246,C00250,C00271,C00272,C00277,C00291,
     *  C00292,
     *  V00004,V00005,V00009,V00012,V00016,V00018,V00022,V00031,
     *  V00041,V00044,V00049,V00052,V00070,V00075,V00078,V00231,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqimisr','CONT_EV_qimisr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01230(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00074,C00217,
     *  V00031,V00044,V00230,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqimr','CONT_EV_qimr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01231(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00074,C00217,
     *  V00031,V00044,V00229,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqxsirs','CONT_EV_qxsirs',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01232(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00072,C00217,
     *  V00031,V00044,V00228,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqxsr','CONT_EV_qxsr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01233(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00072,C00217,
     *  V00031,V00044,V00227,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqgdir','CONT_EV_qgdir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01234(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00063,C00064,C00217,
     *  V00004,V00044,V00226,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqgdr','CONT_EV_qgdr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01235(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00063,C00064,C00217,
     *  V00004,V00044,V00225,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqgmir','CONT_EV_qgmir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01236(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00048,C00049,C00065,C00066,C00076,C00086,C00088,
     *  C00090,C00217,C00234,
     *  V00005,V00009,V00041,V00044,V00049,V00224,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqgmr','CONT_EV_qgmr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01237(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00251,C00252,C00253,C00254,C00255,
     *  V00005,V00009,V00041,V00044,V00049,V00223,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqpdir','CONT_EV_qpdir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01238(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00058,C00059,C00217,
     *  V00012,V00044,V00222,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqpdr','CONT_EV_qpdr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01239(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00058,C00059,C00217,
     *  V00012,V00044,V00221,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqpmir','CONT_EV_qpmir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01240(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00060,C00061,C00076,C00095,C00096,C00099,C00100,
     *  C00217,
     *  V00009,V00016,V00041,V00044,V00052,V00070,V00220,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqpmr','CONT_EV_qpmr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01241(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00060,C00061,C00076,C00099,C00217,C00273,C00274,
     *  C00275,C00276,
     *  V00009,V00016,V00041,V00044,V00052,V00070,V00219,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfdijr','CONT_EV_qfdijr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01242(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00053,C00054,C00217,
     *  V00022,V00044,V00218,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfdir','CONT_EV_qfdir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01243(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00053,C00054,C00217,
     *  V00022,V00044,V00217,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfdr','CONT_EV_qfdr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01244(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00053,C00054,C00217,
     *  V00022,V00044,V00216,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfmijr','CONT_EV_qfmijr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01245(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00055,C00056,C00076,C00106,C00107,C00217,
     *  V00009,V00041,V00044,V00075,V00078,V00215,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfmir','CONT_EV_qfmir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01246(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00055,C00056,C00076,C00217,C00293,C00296,C00297,
     *  V00009,V00041,V00044,V00075,V00078,V00214,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfmr','CONT_EV_qfmr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01247(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00055,C00056,C00076,C00217,C00293,C00294,C00295,
     *  V00009,V00041,V00044,V00075,V00078,V00213,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfeijr','CONT_EV_qfeijr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01248(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00068,C00217,
     *  V00044,V00078,V00212,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00029')
      RETURN
      END
      SUBROUTINE S01249(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00068,C00217,C00316,
     *  V00044,V00078,V00211,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00316(SSZ(6),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00078(SSZ(17),SSZ(7),SSZ(1))
      REAL V00211(SSZ(6),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfeir"',
     *  ' using equation "CONT_EV_qfeir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(6)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS1=RS1-C00068(I00001,I00004,I00002)*0.01  *C00217(I00002)*
     *  V00078(SSMP(SSMPST(15)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00004,I00002)
    3 CONTINUE
      V00211(I00001,I00002)=-(C00316(I00001,I00002)*V00044(I00002)+RS1)
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqfeir"',
     *  ' using equation "CONT_EV_qfeir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01249')
      RETURN
      END
      SUBROUTINE S01250(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00068,C00217,C00315,
     *  V00044,V00078,V00210,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00217(SSZ(1))
      REAL C00315(SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00078(SSZ(17),SSZ(7),SSZ(1))
      REAL V00210(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfer"',
     *  ' using equation "CONT_EV_qfer"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)
      RS2=0.0
      DO 2 I00001=1,SSZ(6)
      RS2=RS2-C00068(I00001,I00004,I00002)*0.01  *C00217(I00002)*
     *  V00078(SSMP(SSMPST(15)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00004,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      V00210(I00002)=-(C00315(I00002)*V00044(I00002)+RS1)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqfer"',
     *  ' using equation "CONT_EV_qfer"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01250')
      RETURN
      END
      SUBROUTINE S01251(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00070,C00217,
     *  V00018,V00044,V00209,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00018(SSZ(9),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00209(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqoir"',
     *  ' using equation "CONT_EV_qoir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(9)
      V00209(I00001,I00002)=C00070(I00001,I00002)*0.01  *C00217(I00002)*
     *  (V00018(I00001,I00002)-V00044(I00002))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqoir"',
     *  ' using equation "CONT_EV_qoir"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01251')
      RETURN
      END
      SUBROUTINE S01252(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00070,C00217,
     *  V00018,V00044,V00208,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00217(SSZ(1))
      REAL V00018(SSZ(9),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00208(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqor"',
     *  ' using equation "CONT_EV_qor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(9)
      RS1=RS1+0.01  *C00217(I00002)*C00070(I00001,I00002)*
     *  (V00018(I00001,I00002)-V00044(I00002))
    2 CONTINUE
      V00208(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "CNTqor"',
     *  ' using equation "CONT_EV_qor"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01252')
      RETURN
      END
      SUBROUTINE S01253(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00018,V00158,V00159,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00018(SSZ(9),SSZ(1))
      REAL V00158(SSZ(1))
      REAL V00159(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "compvalad"',
     *  ' using equation "COMPVALADEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(7)
      DO 2 I00002=1,SSZ(1)
      V00159(I00001,I00002)=(V00018(SSMP(SSMPST(9)-1+I00001),I00002)-
     *  V00158(I00002))
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "compvalad"',
     *  ' using equation "COMPVALADEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01253')
      RETURN
      END
      SUBROUTINE S01254(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00144,C00146,C00147,C00343,
     *  V00005,V00032,V00101,V00102,V00108,V00109,V00110,V00111,
     *  V00115,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00146(SSZ(2),SSZ(1),SSZ(1))
      REAL C00147(SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(2),SSZ(1),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00032(SSZ(2),SSZ(1),SSZ(1))
      REAL V00101(SSZ(2),SSZ(1))
      REAL V00102(SSZ(2),SSZ(1),SSZ(1))
      REAL V00108(SSZ(2))
      REAL V00109(SSZ(2))
      REAL V00110(SSZ(1))
      REAL V00111(SSZ(1))
      REAL V00115(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pcif"',
     *  ' using equation "FOBCIF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 4 I00005=1,SSZ(3)
      RS1=RS1+C00147(I00001,I00002,I00003)*
     *  C00144(I00005,I00001,I00002,I00003)*V00108(SSMP(SSMPST(1)-1+
     *  I00005))
    4 CONTINUE
      RS2=0.0
      DO 5 I00005=1,SSZ(3)
      RS2=RS2-C00147(I00001,I00002,I00003)*
     *  C00144(I00005,I00001,I00002,I00003)*V00115(I00005)
    5 CONTINUE
      V00032(I00001,I00002,I00003)=-(-C00146(I00001,I00002,I00003)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+
     *  C00146(I00001,I00002,I00003)*V00101(I00001,I00002)+
     *  C00146(I00001,I00002,I00003)*V00102(I00001,I00002,I00003)+RS1+
     *  C00343(I00001,I00002,I00003)*V00109(I00001)+
     *  C00343(I00001,I00002,I00003)*V00110(I00002)+
     *  C00343(I00001,I00002,I00003)*V00111(I00003)+RS2)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "pcif"',
     *  ' using equation "FOBCIF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01254')
      RETURN
      END
      SUBROUTINE S01255(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00107,V00108,V00109,V00110,V00111,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00107(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00108(SSZ(2))
      REAL V00109(SSZ(2))
      REAL V00110(SSZ(1))
      REAL V00111(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "atmfsd"',
     *  ' using equation "TRANSTECHANGE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00005=1,SSZ(3)
      DO 2 I00001=1,SSZ(2)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      V00107(I00005,I00001,I00002,I00003)=(V00108(SSMP(SSMPST(1)-1+
     *  I00005))+V00109(I00001)+V00110(I00002)+V00111(I00003))
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "atmfsd"',
     *  ' using equation "TRANSTECHANGE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01255')
      RETURN
      END
      SUBROUTINE S01256(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00144,
     *  V00107,V00113,V00115,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00144(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00107(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00113(SSZ(2),SSZ(1),SSZ(1))
      REAL V00115(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "ptrans"',
     *  ' using equation "TRANSCOSTINDEX"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 4 I00005=1,SSZ(3)
      RS1=RS1+C00144(I00005,I00001,I00002,I00003)*(V00115(I00005)-
     *  V00107(I00005,I00001,I00002,I00003))
    4 CONTINUE
      V00113(I00001,I00002,I00003)=RS1
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "ptrans"',
     *  ' using equation "TRANSCOSTINDEX"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01256')
      RETURN
      END
      SUBROUTINE S01257(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00031,V00106,V00107,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00106(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00107(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qtmfsd"',
     *  ' using equation "QTRANS_MFSD"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00005=1,SSZ(3)
      DO 2 I00001=1,SSZ(2)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      V00106(I00005,I00001,I00002,I00003)=(V00031(I00001,I00002,I00003)-
     *  V00107(I00005,I00001,I00002,I00003))
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "qtmfsd"',
     *  ' using equation "QTRANS_MFSD"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01257')
      RETURN
      END
      SUBROUTINE S01258(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00030,V00032,V00103,V00104,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00030(SSZ(2),SSZ(1),SSZ(1))
      REAL V00032(SSZ(2),SSZ(1),SSZ(1))
      REAL V00103(SSZ(2),SSZ(1))
      REAL V00104(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pms"',
     *  ' using equation "MKTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(2)
      DO 2 I00002=1,SSZ(1)
      DO 3 I00003=1,SSZ(1)
      V00030(I00001,I00002,I00003)=(V00103(I00001,I00003)+
     *  V00104(I00001,I00002,I00003)+V00032(I00001,I00002,I00003))
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "pms"',
     *  ' using equation "MKTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01258')
      RETURN
      END
      SUBROUTINE S01259(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00005,V00033,V00101,V00102,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00033(SSZ(2),SSZ(1),SSZ(1))
      REAL V00101(SSZ(2),SSZ(1))
      REAL V00102(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pfob"',
     *  ' using equation "EXPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(2)
      DO 2 I00002=1,SSZ(1)
      DO 3 I00003=1,SSZ(1)
      V00033(I00001,I00002,I00003)=(V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)-V00101(I00001,I00002)-
     *  V00102(I00001,I00002,I00003))
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "pfob"',
     *  ' using equation "EXPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01259')
      RETURN
      END
      SUBROUTINE S01260(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00020,V00078,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00020(SSZ(6),SSZ(7),SSZ(1))
      REAL V00078(SSZ(17),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qfe"',
     *  ' using equation "QFEEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(6)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      V00020(I00001,I00004,I00002)=V00078(SSMP(SSMPST(15)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00004,I00002)
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "qfe"',
     *  ' using equation "QFEEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01260')
      RETURN
      END
      SUBROUTINE S01261(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00079,V00082,V00083,V00084,V00085,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00079(SSZ(17),SSZ(7),SSZ(1))
      REAL V00082(SSZ(17))
      REAL V00083(SSZ(7))
      REAL V00084(SSZ(1))
      REAL V00085(SSZ(17),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "af"',
     *  ' using equation "AFWORLD"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(17)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      V00079(I00001,I00004,I00002)=(V00082(I00001)+V00083(I00004)+
     *  V00084(I00002)+V00085(I00001,I00004,I00002))
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "af"',
     *  ' using equation "AFWORLD"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01261')
      RETURN
      END
      SUBROUTINE S01262(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00086,V00087,V00088,V00089,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00086(SSZ(7),SSZ(1))
      REAL V00087(SSZ(7))
      REAL V00088(SSZ(1))
      REAL V00089(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "ao"',
     *  ' using equation "AOWORLD"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00004=1,SSZ(7)
      DO 2 I00002=1,SSZ(1)
      V00086(I00004,I00002)=(V00087(I00004)+V00088(I00002)+
     *  V00089(I00004,I00002))
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "ao"',
     *  ' using equation "AOWORLD"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01262')
      RETURN
      END
      SUBROUTINE S01263(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00076,C00106,C00107,
     *  V00009,V00025,V00041,V00075,V00078,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00025(SSZ(2),SSZ(7),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00075(SSZ(2),SSZ(7),SSZ(1))
      REAL V00078(SSZ(17),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qfm"',
     *  ' using equation "INDIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      V00025(I00001,I00004,I00003)=-(C00076(I00001)*
     *  C00106(I00001,I00004,I00003)*V00009(I00001,I00003)+
     *  C00076(I00001)*100.0 *C00107(I00001,I00004,I00003)*
     *  V00041(C00008(I00003))-C00076(I00001)*
     *  V00075(I00001,I00004,I00003)-1.0*V00078(SSMP(SSMPST(15)-1+
     *  SSMP(SSMPST(6)-1+I00001)),I00004,I00003))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "qfm"',
     *  ' using equation "INDIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01263')
      RETURN
      END
      SUBROUTINE S01264(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00106,C00107,
     *  V00009,V00024,V00041,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00106(SSZ(2),SSZ(7),SSZ(1))
      REAL C00107(SSZ(2),SSZ(7),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00024(SSZ(2),SSZ(7),SSZ(1))
      REAL V00041(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pfm"',
     *  ' using equation "DMNDIPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      V00024(I00001,I00004,I00002)=(C00106(I00001,I00004,I00002)*
     *  V00009(I00001,I00002)+100.0 *C00107(I00001,I00004,I00002)*
     *  V00041(C00008(I00002)))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "pfm"',
     *  ' using equation "DMNDIPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01264')
      RETURN
      END
      SUBROUTINE S01265(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00104,C00105,
     *  V00005,V00021,V00041,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00104(SSZ(2),SSZ(7),SSZ(1))
      REAL C00105(SSZ(2),SSZ(7),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00021(SSZ(2),SSZ(7),SSZ(1))
      REAL V00041(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pfd"',
     *  ' using equation "DMNDDPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      V00021(I00001,I00004,I00002)=(C00104(I00001,I00004,I00002)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+
     *  100.0 *C00105(I00001,I00004,I00002)*V00041(C00008(I00002)))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "pfd"',
     *  ' using equation "DMNDDPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01265')
      RETURN
      END
      SUBROUTINE S01266(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00076,V00078,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00076(SSZ(2),SSZ(7),SSZ(1))
      REAL V00078(SSZ(17),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qft"',
     *  ' using equation "QFTEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(2)
      DO 2 I00004=1,SSZ(7)
      DO 3 I00002=1,SSZ(1)
      V00076(I00001,I00004,I00002)=V00078(SSMP(SSMPST(15)-1+
     *  SSMP(SSMPST(6)-1+I00001)),I00004,I00002)
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "qft"',
     *  ' using equation "QFTEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01266')
      RETURN
      END
      SUBROUTINE S01267(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00076,C00095,C00096,C00099,C00100,
     *  V00009,V00015,V00016,V00041,V00044,V00052,V00070,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00015(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00044(SSZ(1))
      REAL V00052(SSZ(1))
      REAL V00070(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qpm"',
     *  ' using equation "PHHLDAGRIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00008=1,SSZ(2)
      RS1=RS1-C00096(I00001,I00008,I00003)*V00070(I00008,I00003)
    3 CONTINUE
      V00015(I00001,I00003)=-(C00076(I00001)*C00099(I00001,I00003)*
     *  V00009(I00001,I00003)+C00076(I00001)*C00099(I00001,I00003)*
     *  V00016(I00001,I00003)+C00076(I00001)*100.0 *
     *  C00100(I00001,I00003)*V00041(C00008(I00003))+(-1.0+
     *  C00095(I00001,I00003))*V00044(I00003)-C00095(I00001,I00003)*
     *  V00052(I00003)+RS1-C00076(I00001)*V00070(I00001,I00003))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "qpm"',
     *  ' using equation "PHHLDAGRIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01267')
      RETURN
      END
      SUBROUTINE S01268(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00099,C00100,
     *  V00009,V00014,V00016,V00041,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00099(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00014(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "ppm"',
     *  ' using equation "PHHIPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      V00014(I00001,I00002)=(C00099(I00001,I00002)*
     *  (V00009(I00001,I00002)+V00016(I00001,I00002))+100.0 *
     *  C00100(I00001,I00002)*V00041(C00008(I00002)))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "ppm"',
     *  ' using equation "PHHIPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01268')
      RETURN
      END
      SUBROUTINE S01269(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00097,C00098,
     *  V00005,V00011,V00013,V00041,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00097(SSZ(2),SSZ(1))
      REAL C00098(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00011(SSZ(2),SSZ(1))
      REAL V00013(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "ppd"',
     *  ' using equation "PHHDPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      V00011(I00001,I00002)=(C00097(I00001,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+
     *  V00013(I00001,I00002))+100.0 *C00098(I00001,I00002)*
     *  V00041(C00008(I00002)))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "ppd"',
     *  ' using equation "PHHDPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01269')
      RETURN
      END
      SUBROUTINE S01270(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00095,C00096,
     *  V00044,V00052,V00070,V00071,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00095(SSZ(2),SSZ(1))
      REAL C00096(SSZ(2),SSZ(2),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00052(SSZ(1))
      REAL V00070(SSZ(2),SSZ(1))
      REAL V00071(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qp"',
     *  ' using equation "PRIVDMNDS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00008=1,SSZ(2)
      RS1=RS1+C00096(I00001,I00008,I00002)*V00070(I00008,I00002)
    3 CONTINUE
      V00071(I00001,I00002)=-(-V00044(I00002)-(RS1+
     *  C00095(I00001,I00002)*(V00052(I00002)-V00044(I00002))))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "qp"',
     *  ' using equation "PRIVDMNDS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01270')
      RETURN
      END
      SUBROUTINE S01271(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00048,C00049,C00076,C00086,C00088,C00090,C00234,
     *  V00005,V00008,V00009,V00041,V00044,V00049,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00234(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00008(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00044(SSZ(1))
      REAL V00049(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qgm"',
     *  ' using equation "GHHLDAGRIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=-C00048(I00011,I00003)
      RS3=C00049(I00003)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(1  -C00090(I00011,I00003))*C00086(I00011,I00003)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00011)),I00003)
    3 CONTINUE
      RS5=0.0
      DO 4 I00011=1,SSZ(2)
      RS6=-C00048(I00011,I00003)
      RS7=C00049(I00003)
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS5=RS5+RS8*C00090(I00011,I00003)*C00088(I00011,I00003)*
     *  V00009(I00011,I00003)
    4 CONTINUE
      V00008(I00001,I00003)=-(-(-1.0+C00076(I00001))*(1  -
     *  C00090(I00001,I00003))*C00086(I00001,I00003)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00003)+RS1+
     *  (C00076(I00001)*C00088(I00001,I00003)-(-1.0+C00076(I00001))*
     *  C00090(I00001,I00003)*C00088(I00001,I00003))*
     *  V00009(I00001,I00003)+RS5+C00234(I00001,I00003)*
     *  V00041(C00008(I00003))-1.0*V00044(I00003)-1.0*V00049(I00003))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "qgm"',
     *  ' using equation "GHHLDAGRIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01271')
      RETURN
      END
      SUBROUTINE S01272(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00086,C00087,C00088,C00089,C00090,
     *  V00005,V00009,V00041,V00068,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      REAL V00068(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pg"',
     *  ' using equation "GCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      V00068(I00001,I00003)=-(-(1  -C00090(I00001,I00003))*
     *  C00086(I00001,I00003)*V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00003)-C00090(I00001,I00003)*C00088(I00001,I00003)*
     *  V00009(I00001,I00003)+(-C00090(I00001,I00003)*100.0 *
     *  C00089(I00001,I00003)-(1  -C00090(I00001,I00003))*100.0 *
     *  C00087(I00001,I00003))*V00041(C00008(I00003)))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "pg"',
     *  ' using equation "GCOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01272')
      RETURN
      END
      SUBROUTINE S01273(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00088,C00089,
     *  V00007,V00009,V00041,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL V00007(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00041(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pgm"',
     *  ' using equation "GHHIPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      V00007(I00001,I00002)=(C00088(I00001,I00002)*
     *  V00009(I00001,I00002)+100.0 *C00089(I00001,I00002)*
     *  V00041(C00008(I00002)))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "pgm"',
     *  ' using equation "GHHIPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01273')
      RETURN
      END
      SUBROUTINE M00030(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  CWKUN,
     *  FSTPAS,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c1
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER CWKUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) ERRMES
      LOGICAL FSTPAS
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfeir','CONT_EV_qfeir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01249(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00068,C00217,C00316,
     *  V00044,V00078,V00211,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfer','CONT_EV_qfer',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01250(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00068,C00217,C00315,
     *  V00044,V00078,V00210,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqoir','CONT_EV_qoir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01251(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00070,C00217,
     *  V00018,V00044,V00209,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqor','CONT_EV_qor',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01252(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00070,C00217,
     *  V00018,V00044,V00208,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'compvalad','COMPVALADEQ',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01253(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00018,V00158,V00159,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pcif','FOBCIF',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01254(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00144,C00146,C00147,C00343,
     *  V00005,V00032,V00101,V00102,V00108,V00109,V00110,V00111,
     *  V00115,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'atmfsd','TRANSTECHANGE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01255(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00107,V00108,V00109,V00110,V00111,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'ptrans','TRANSCOSTINDEX',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01256(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00144,
     *  V00107,V00113,V00115,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qtmfsd','QTRANS_MFSD',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01257(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00031,V00106,V00107,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pms','MKTPRICES',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01258(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00030,V00032,V00103,V00104,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pfob','EXPRICES',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01259(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00005,V00033,V00101,V00102,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qfe','QFEEQ',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01260(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00020,V00078,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'af','AFWORLD',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01261(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00079,V00082,V00083,V00084,V00085,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'ao','AOWORLD',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01262(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00086,V00087,V00088,V00089,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qfm','INDIMP',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01263(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00076,C00106,C00107,
     *  V00009,V00025,V00041,V00075,V00078,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pfm','DMNDIPRICES',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01264(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00106,C00107,
     *  V00009,V00024,V00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pfd','DMNDDPRICE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01265(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00104,C00105,
     *  V00005,V00021,V00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qft','QFTEQ',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01266(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00076,V00078,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qpm','PHHLDAGRIMP',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01267(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00076,C00095,C00096,C00099,C00100,
     *  V00009,V00015,V00016,V00041,V00044,V00052,V00070,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'ppm','PHHIPRICES',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01268(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00099,C00100,
     *  V00009,V00014,V00016,V00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'ppd','PHHDPRICE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01269(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00097,C00098,
     *  V00005,V00011,V00013,V00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qp','PRIVDMNDS',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01270(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00095,C00096,
     *  V00044,V00052,V00070,V00071,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qgm','GHHLDAGRIMP',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01271(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00048,C00049,C00076,C00086,C00088,C00090,C00234,
     *  V00005,V00008,V00009,V00041,V00044,V00049,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pg','GCOMPRICE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01272(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00086,C00087,C00088,C00089,C00090,
     *  V00005,V00009,V00041,V00068,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pgm','GHHIPRICES',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01273(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00088,C00089,
     *  V00007,V00009,V00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00030')
      RETURN
      END
      SUBROUTINE S01274(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00086,C00087,
     *  V00003,V00005,V00041,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL V00003(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00041(SSZ(15))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pgd"',
     *  ' using equation "GHHDPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      V00003(I00001,I00002)=(C00086(I00001,I00002)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+
     *  100.0 *C00087(I00001,I00002)*V00041(C00008(I00002)))
    1 CONTINUE
    2 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "pgd"',
     *  ' using equation "GHHDPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01274')
      RETURN
      END
      SUBROUTINE S01275(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00048,C00049,
     *  V00044,V00049,V00068,V00069,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00049(SSZ(1))
      REAL V00068(SSZ(2),SSZ(1))
      REAL V00069(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qg"',
     *  ' using equation "GOVDMNDS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(2)
      DO 2 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00011=1,SSZ(2)
      RS2=-C00048(I00011,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*V00068(I00011,I00002)
    3 CONTINUE
      V00069(I00001,I00002)=-(-1.0*V00044(I00002)-1.0*V00049(I00002)+
     *  1.0*V00068(I00001,I00002)+RS1)
    2 CONTINUE
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "qg"',
     *  ' using equation "GOVDMNDS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01275')
      RETURN
      END
      SUBROUTINE S01276(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00048,C00049,
     *  V00047,V00068,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      REAL V00047(SSZ(1))
      REAL V00068(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pgov"',
     *  ' using equation "GPRICEINDEX"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)
      RS2=C00048(I00001,I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*V00068(I00001,I00002)
    2 CONTINUE
      V00047(I00002)=RS1
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating backsolve for variable "pgov"',
     *  ' using equation "GPRICEINDEX"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01276')
      RETURN
      END
      SUBROUTINE M00031(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  CWKUN,
     *  FSTPAS,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c1
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER CWKUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) ERRMES
      LOGICAL FSTPAS
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pgd','GHHDPRICE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01274(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00086,C00087,
     *  V00003,V00005,V00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qg','GOVDMNDS',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01275(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00048,C00049,
     *  V00044,V00049,V00068,V00069,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pgov','GPRICEINDEX',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01276(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00048,C00049,
     *  V00047,V00068,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00031')
      RETURN
      END
      SUBROUTINE S01277(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00001,
     *  U00001,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00001(1)
      REAL U00001(1)
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VERNUM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      U00001(1)=C00001(1)*0.0
      CALL GPARW(SIZE(C00001),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(1),KSTEP,NSTEP,METHOD,
     *    1,1,1,1,
     *    1,1,1,
     *    1,1,1,1,
     *    1,1,1,
     *    C00001,U00001,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VERNUM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01277')
      RETURN
      END
      SUBROUTINE S01280(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00009,
     *  V00001,V00002,
     *  U00009,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL V00001(SSZ(1))
      REAL V00002(SSZ(1))
      REAL U00009(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "SAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00009(I00002)=C00009(I00002)*(V00001(I00002)/100.0 +
     *  V00002(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00009),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(9),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00009,U00009,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "SAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01280')
      RETURN
      END
      SUBROUTINE S01281(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00010,
     *  V00003,V00004,
     *  U00010,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL V00003(SSZ(2),SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL U00010(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00010(I00001,I00002)=C00010(I00001,I00002)*
     *  (V00003(I00001,I00002)/100.0 +V00004(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00010),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(10),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00010,U00010,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01281')
      RETURN
      END
      SUBROUTINE S01282(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00011,
     *  V00004,V00005,
     *  U00011,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00011(SSZ(2),SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL U00011(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00011(I00001,I00002)=C00011(I00001,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00004(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00011),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(11),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00011,U00011,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDGANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01282')
      RETURN
      END
      SUBROUTINE S01283(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00012,
     *  V00004,V00005,
     *  U00012,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00012(SSZ(2),SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL U00012(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00012(I00001,I00002)=C00012(I00001,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00004(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00012),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(12),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00012,U00012,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01283')
      RETURN
      END
      SUBROUTINE S01284(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00013,
     *  V00007,V00008,
     *  U00013,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL V00007(SSZ(2),SSZ(1))
      REAL V00008(SSZ(2),SSZ(1))
      REAL U00013(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00013(I00001,I00002)=C00013(I00001,I00002)*
     *  (V00007(I00001,I00002)/100.0 +V00008(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00013),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(13),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00013,U00013,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIGA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01284')
      RETURN
      END
      SUBROUTINE S01285(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00014,
     *  V00008,V00009,
     *  U00014,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00014(SSZ(2),SSZ(1))
      REAL V00008(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL U00014(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00014(I00001,I00002)=C00014(I00001,I00002)*
     *  (V00009(I00001,I00002)/100.0 +V00008(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00014),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(14),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00014,U00014,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIGANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01285')
      RETURN
      END
      SUBROUTINE S01286(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00015,
     *  V00008,V00009,
     *  U00015,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00015(SSZ(2),SSZ(1))
      REAL V00008(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL U00015(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00015(I00001,I00002)=C00015(I00001,I00002)*
     *  (V00009(I00001,I00002)/100.0 +V00008(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00015),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(15),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00015,U00015,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIGM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01286')
      RETURN
      END
      SUBROUTINE S01287(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00016,
     *  V00011,V00012,
     *  U00016,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL V00011(SSZ(2),SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL U00016(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00016(I00001,I00002)=C00016(I00001,I00002)*
     *  (V00011(I00001,I00002)/100.0 +V00012(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00016),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(16),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00016,U00016,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01287')
      RETURN
      END
      SUBROUTINE S01288(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00017,
     *  V00005,V00012,V00013,
     *  U00017,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00017(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL V00013(SSZ(2),SSZ(1))
      REAL U00017(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00017(I00001,I00002)=C00017(I00001,I00002)*
     *  (V00013(I00001,I00002)/100.0 +V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)/100.0 +
     *  V00012(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00017),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(17),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00017,U00017,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDPANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01288')
      RETURN
      END
      SUBROUTINE S01289(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00018,
     *  V00005,V00012,
     *  U00018,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00018(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL U00018(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00018(I00001,I00002)=C00018(I00001,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00012(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00018),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(18),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00018,U00018,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01289')
      RETURN
      END
      SUBROUTINE S01290(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00019,
     *  V00014,V00015,
     *  U00019,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL V00014(SSZ(2),SSZ(1))
      REAL V00015(SSZ(2),SSZ(1))
      REAL U00019(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00019(I00001,I00002)=C00019(I00001,I00002)*
     *  (V00014(I00001,I00002)/100.0 +V00015(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00019),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(19),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00019,U00019,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIPA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01290')
      RETURN
      END
      SUBROUTINE S01291(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00020,
     *  V00009,V00015,V00016,
     *  U00020,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00020(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00015(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL U00020(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00020(I00001,I00002)=C00020(I00001,I00002)*
     *  (V00016(I00001,I00002)/100.0 +V00009(I00001,I00002)/100.0 +
     *  V00015(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00020),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(20),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00020,U00020,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIPANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01291')
      RETURN
      END
      SUBROUTINE S01292(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00021,
     *  V00009,V00015,
     *  U00021,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00021(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00015(SSZ(2),SSZ(1))
      REAL U00021(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00021(I00001,I00002)=C00021(I00001,I00002)*
     *  (V00009(I00001,I00002)/100.0 +V00015(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00021),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(21),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00021,U00021,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01292')
      RETURN
      END
      SUBROUTINE S01293(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00022,
     *  V00017,V00018,
     *  U00022,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00022(SSZ(6),SSZ(1))
      REAL V00017(SSZ(9),SSZ(1))
      REAL V00018(SSZ(9),SSZ(1))
      REAL U00022(SSZ(6),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "EVOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(6)
      U00022(I00001,I00002)=C00022(I00001,I00002)*
     *  (V00017(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00002)/100.0 +V00018(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-
     *  1+I00001)),I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00022),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(22),KSTEP,NSTEP,METHOD,
     *    SSZ(6),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(6),SSZ(1),1,1,
     *    1,1,1,
     *    C00022,U00022,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "EVOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01293')
      RETURN
      END
      SUBROUTINE S01294(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00023,
     *  V00019,V00020,
     *  U00023,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00023(SSZ(6),SSZ(7),SSZ(1))
      REAL V00019(SSZ(6),SSZ(7),SSZ(1))
      REAL V00020(SSZ(6),SSZ(7),SSZ(1))
      REAL U00023(SSZ(6),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "EVFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(6)
      U00023(I00001,I00004,I00002)=C00023(I00001,I00004,I00002)*
     *  (V00019(I00001,I00004,I00002)/100.0 +
     *  V00020(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00023),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(23),KSTEP,NSTEP,METHOD,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00023,U00023,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "EVFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01294')
      RETURN
      END
      SUBROUTINE S01295(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00024,
     *  V00021,V00022,
     *  U00024,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL V00021(SSZ(2),SSZ(7),SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL U00024(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00024(I00001,I00004,I00002)=C00024(I00001,I00004,I00002)*
     *  (V00021(I00001,I00004,I00002)/100.0 +
     *  V00022(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00024),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(24),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00024,U00024,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01295')
      RETURN
      END
      SUBROUTINE S01296(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00025,
     *  V00005,V00022,
     *  U00025,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00025(SSZ(2),SSZ(7),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL U00025(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00025(I00001,I00004,I00002)=C00025(I00001,I00004,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00022(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00025),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(25),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00025,U00025,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDFANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01296')
      RETURN
      END
      SUBROUTINE S01297(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00026,
     *  V00024,V00025,
     *  U00026,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL V00024(SSZ(2),SSZ(7),SSZ(1))
      REAL V00025(SSZ(2),SSZ(7),SSZ(1))
      REAL U00026(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00026(I00001,I00004,I00002)=C00026(I00001,I00004,I00002)*
     *  (V00024(I00001,I00004,I00002)/100.0 +
     *  V00025(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00026),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(26),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00026,U00026,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIFA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01297')
      RETURN
      END
      SUBROUTINE S01298(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00027,
     *  V00009,V00025,
     *  U00027,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00027(SSZ(2),SSZ(7),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00025(SSZ(2),SSZ(7),SSZ(1))
      REAL U00027(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00027(I00001,I00004,I00002)=C00027(I00001,I00004,I00002)*
     *  (V00009(I00001,I00002)/100.0 +
     *  V00025(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00027),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(27),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00027,U00027,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIFANC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01298')
      RETURN
      END
      SUBROUTINE S01299(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00028,
     *  V00005,V00020,V00027,
     *  U00028,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00028(SSZ(6),SSZ(7),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00020(SSZ(6),SSZ(7),SSZ(1))
      REAL V00027(SSZ(10),SSZ(7),SSZ(1))
      REAL U00028(SSZ(6),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPCVAR(
     *  SSZ(6),SSZ(7),SSZ(1),1,
     *  1,1,1,
     *  U00028,0.0,1,1,1,1,1,1,1,
     *  SSZ(6),SSZ(7),SSZ(1),1,
     *  1,1,1,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(11)
      U00028(SSMP(SSMPST(11)-1+I00001),I00004,I00002)=
     *  C00028(SSMP(SSMPST(11)-1+I00001),I00004,I00002)*
     *  (V00005(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001))),I00002)/100.0 +V00020(SSMP(SSMPST(11)-1+
     *  I00001),I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      DO 6 I00002=1,SSZ(1)
      DO 5 I00004=1,SSZ(7)
      DO 4 I00001=1,SSZ(10)
      U00028(SSMP(SSMPST(10)-1+I00001),I00004,I00002)=
     *  C00028(SSMP(SSMPST(10)-1+I00001),I00004,I00002)*
     *  (V00027(I00001,I00004,I00002)/100.0 +V00020(SSMP(SSMPST(10)-1+
     *  I00001),I00004,I00002)/100.0 )
    4 CONTINUE
    5 CONTINUE
    6 CONTINUE
      CALL GPARW(SIZE(C00028),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(28),KSTEP,NSTEP,METHOD,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00028,U00028,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01299')
      RETURN
      END
      SUBROUTINE S01300(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00029,
     *  V00009,V00025,
     *  U00029,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00029(SSZ(2),SSZ(7),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00025(SSZ(2),SSZ(7),SSZ(1))
      REAL U00029(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00029(I00001,I00004,I00002)=C00029(I00001,I00004,I00002)*
     *  (V00009(I00001,I00002)/100.0 +
     *  V00025(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00029),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(29),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00029,U00029,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01300')
      RETURN
      END
      SUBROUTINE S01301(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00030,
     *  V00005,V00022,
     *  U00030,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00030(SSZ(2),SSZ(7),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL U00030(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00030(I00001,I00004,I00002)=C00030(I00001,I00004,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00022(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00030),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(30),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00030,U00030,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDFM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01301')
      RETURN
      END
      SUBROUTINE S01302(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00031,
     *  V00028,V00029,
     *  U00031,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL V00028(SSZ(1))
      REAL V00029(SSZ(1))
      REAL U00031(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDEP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00031(I00002)=C00031(I00002)*(V00028(I00002)/100.0 +
     *  V00029(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00031),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(31),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00031,U00031,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VDEP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01302')
      RETURN
      END
      SUBROUTINE M00032(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,RTSIOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,NELTX,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c1
      USE gtap_u1
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL LDOWR,NELTX,RTSIOK
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOGICAL CPDOAC,CPDOAP
      COMMON/CPLOG1/ CPDOAC,CPDOAP
      DOUBLE PRECISION CPSLEN,CPSDON,CPSTOT
      COMMON /CPDBL2/ CPSLEN,CPSDON,CPSTOT
      LOGICAL CPSKAC
      COMMON /CPLOG7/CPSKAC
      INTEGER :: LDSPDEC,LDSPCPN,LDSPCLN
      LDOWR=(KSTEPA.EQ.NPASSA).AND.(.NOT.CPDOAP)
      IF(CPDOAP.AND.CPSKAC) LDOWR=(CPSTOT.EQ.1.0D0)
      LOWMEM=.FALSE.
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VERNUM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01277(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00001,
     *  U00001,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'SAVE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01280(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00009,
     *  V00001,V00002,
     *  U00009,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDGA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01281(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00010,
     *  V00003,V00004,
     *  U00010,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00010),U00010,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDGANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01282(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00011,
     *  V00004,V00005,
     *  U00011,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00011),U00011,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDGM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01283(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00012,
     *  V00004,V00005,
     *  U00012,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00012),U00012,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIGA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01284(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00013,
     *  V00007,V00008,
     *  U00013,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00013),U00013,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIGANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01285(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00014,
     *  V00008,V00009,
     *  U00014,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00014),U00014,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIGM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01286(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00015,
     *  V00008,V00009,
     *  U00015,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00015),U00015,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDPA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01287(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00016,
     *  V00011,V00012,
     *  U00016,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00016),U00016,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDPANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01288(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00017,
     *  V00005,V00012,V00013,
     *  U00017,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00017),U00017,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01289(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00018,
     *  V00005,V00012,
     *  U00018,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00018),U00018,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIPA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01290(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00019,
     *  V00014,V00015,
     *  U00019,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00019),U00019,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIPANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01291(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00020,
     *  V00009,V00015,V00016,
     *  U00020,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00020),U00020,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01292(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00021,
     *  V00009,V00015,
     *  U00021,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00021),U00021,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'EVOA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01293(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00022,
     *  V00017,V00018,
     *  U00022,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00022),U00022,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'EVFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01294(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00023,
     *  V00019,V00020,
     *  U00023,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00023),U00023,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01295(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00024,
     *  V00021,V00022,
     *  U00024,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00024),U00024,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDFANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01296(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00025,
     *  V00005,V00022,
     *  U00025,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00025),U00025,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01297(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00026,
     *  V00024,V00025,
     *  U00026,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00026),U00026,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIFANC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01298(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00027,
     *  V00009,V00025,
     *  U00027,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00027),U00027,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01299(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00028,
     *  V00005,V00020,V00027,
     *  U00028,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00028),U00028,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01300(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00029,
     *  V00009,V00025,
     *  U00029,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00029),U00029,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01301(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00030,
     *  V00005,V00022,
     *  U00030,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00030),U00030,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDEP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01302(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00031,
     *  V00028,V00029,
     *  U00031,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00032')
      RETURN
      END
      SUBROUTINE S01303(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00032,
     *  V00030,V00031,
     *  U00032,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL V00030(SSZ(2),SSZ(1),SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL U00032(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIMS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00032(I00001,I00002,I00003)=C00032(I00001,I00002,I00003)*
     *  (V00030(I00001,I00002,I00003)/100.0 +
     *  V00031(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00032),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(32),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00032,U00032,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIMS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01303')
      RETURN
      END
      SUBROUTINE S01304(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00033,
     *  V00031,V00032,
     *  U00033,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00032(SSZ(2),SSZ(1),SSZ(1))
      REAL U00033(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIWS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00033(I00001,I00002,I00003)=C00033(I00001,I00002,I00003)*
     *  (V00032(I00001,I00002,I00003)/100.0 +
     *  V00031(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00033),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(33),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00033,U00033,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VIWS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01304')
      RETURN
      END
      SUBROUTINE S01305(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00034,
     *  V00031,V00033,
     *  U00034,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00033(SSZ(2),SSZ(1),SSZ(1))
      REAL U00034(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VXWD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00034(I00001,I00002,I00003)=C00034(I00001,I00002,I00003)*
     *  (V00033(I00001,I00002,I00003)/100.0 +
     *  V00031(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00034),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(34),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00034,U00034,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VXWD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01305')
      RETURN
      END
      SUBROUTINE S01306(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00035,
     *  V00005,V00031,
     *  U00035,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL U00035(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VXMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00035(I00001,I00002,I00003)=C00035(I00001,I00002,I00003)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00031(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00035),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(35),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00035,U00035,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VXMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01306')
      RETURN
      END
      SUBROUTINE S01307(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00036,
     *  V00005,V00034,
     *  U00036,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00034(SSZ(3),SSZ(1))
      REAL U00036(SSZ(3),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(3)
      U00036(I00005,I00002)=C00036(I00005,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005))),I00002)/100.0 +V00034(I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00036),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(36),KSTEP,NSTEP,METHOD,
     *    SSZ(3),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(3),SSZ(1),1,1,
     *    1,1,1,
     *    C00036,U00036,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01307')
      RETURN
      END
      SUBROUTINE S01308(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00037,
     *  V00035,
     *  U00037,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00037(SSZ(2),SSZ(7),SSZ(1))
      REAL V00035(SSZ(2),SSZ(7),SSZ(1))
      REAL U00037(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2DF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00037(I00001,I00004,I00002)=C00037(I00001,I00004,I00002)*
     *  (V00035(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00037),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(37),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00037,U00037,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "CO2DF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01308')
      RETURN
      END
      SUBROUTINE S01309(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00038,
     *  V00036,
     *  U00038,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00038(SSZ(2),SSZ(7),SSZ(1))
      REAL V00036(SSZ(2),SSZ(7),SSZ(1))
      REAL U00038(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2IF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(7)
      DO 1 I00001=1,SSZ(2)
      U00038(I00001,I00004,I00002)=C00038(I00001,I00004,I00002)*
     *  (V00036(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00038),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(38),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00038,U00038,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "CO2IF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01309')
      RETURN
      END
      SUBROUTINE S01310(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00039,
     *  V00037,
     *  U00039,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00039(SSZ(2),SSZ(1))
      REAL V00037(SSZ(2),SSZ(1))
      REAL U00039(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2DG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00039(I00001,I00002)=C00039(I00001,I00002)*
     *  (V00037(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00039),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(39),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00039,U00039,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "CO2DG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01310')
      RETURN
      END
      SUBROUTINE S01311(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00040,
     *  V00038,
     *  U00040,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00040(SSZ(2),SSZ(1))
      REAL V00038(SSZ(2),SSZ(1))
      REAL U00040(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2IG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00040(I00001,I00002)=C00040(I00001,I00002)*
     *  (V00038(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00040),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(40),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00040,U00040,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "CO2IG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01311')
      RETURN
      END
      SUBROUTINE S01312(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00041,
     *  V00039,
     *  U00041,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00041(SSZ(2),SSZ(1))
      REAL V00039(SSZ(2),SSZ(1))
      REAL U00041(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2DP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00041(I00001,I00002)=C00041(I00001,I00002)*
     *  (V00039(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00041),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(41),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00041,U00041,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "CO2DP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01312')
      RETURN
      END
      SUBROUTINE S01313(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00042,
     *  V00040,
     *  U00042,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00042(SSZ(2),SSZ(1))
      REAL V00040(SSZ(2),SSZ(1))
      REAL U00042(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2IP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00042(I00001,I00002)=C00042(I00001,I00002)*
     *  (V00040(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00042),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(42),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00042,U00042,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "CO2IP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01313')
      RETURN
      END
      SUBROUTINE S01314(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00043,
     *  V00041,
     *  U00043,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00043(SSZ(1))
      REAL V00041(SSZ(15))
      REAL U00043(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "NCTAXLEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00043(I00002)=V00041(C00008(I00002))
    1 CONTINUE
      CALL GPARW(SIZE(C00043),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(43),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00043,U00043,RWORK,.TRUE.,'c',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "NCTAXLEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01314')
      RETURN
      END
      SUBROUTINE S01324(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00128,
     *  V00028,V00029,
     *  U00128,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00128(SSZ(1))
      REAL V00028(SSZ(1))
      REAL V00029(SSZ(1))
      REAL U00128(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VKB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00128(I00002)=C00128(I00002)*(V00029(I00002)/100.0 +
     *  V00028(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00128),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(128),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00128,U00128,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VKB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01324')
      RETURN
      END
      SUBROUTINE S01328(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00135,
     *  V00106,V00115,
     *  U00135,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00106(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00115(SSZ(3))
      REAL U00135(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VTMFSD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00003=1,SSZ(1)
      DO 3 I00002=1,SSZ(1)
      DO 2 I00001=1,SSZ(2)
      DO 1 I00005=1,SSZ(3)
      U00135(I00005,I00001,I00002,I00003)=
     *  C00135(I00005,I00001,I00002,I00003)*(V00115(I00005)/100.0 +
     *  V00106(I00005,I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00135),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(135),KSTEP,NSTEP,METHOD,
     *    SSZ(3),SSZ(2),SSZ(1),SSZ(1),
     *    1,1,1,
     *    SSZ(3),SSZ(2),SSZ(1),SSZ(1),
     *    1,1,1,
     *    C00135,U00135,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VTMFSD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01328')
      RETURN
      END
      SUBROUTINE S01329(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00148,
     *  V00116,
     *  U00148,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00148(SSZ(1))
      REAL V00116(SSZ(1))
      REAL U00148(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2Q"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00148(I00002)=C00148(I00002)*(V00116(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00148),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(148),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00148,U00148,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "CO2Q"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01329')
      RETURN
      END
      SUBROUTINE S01331(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00157,
     *  V00043,
     *  U00157,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00157(SSZ(1))
      REAL V00043(SSZ(1))
      REAL U00157(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "PIND"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00157(I00002)=C00157(I00002)*(V00043(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00157),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(157),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00157,U00157,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "PIND"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01331')
      RETURN
      END
      SUBROUTINE S01332(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00159,
     *  V00129,
     *  U00159,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00006
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00159(SSZ(15))
      REAL V00129(SSZ(15))
      REAL U00159(SSZ(15))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "PINDB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00006=1,SSZ(15)
      U00159(I00006)=C00159(I00006)*(V00129(I00006)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00159),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(159),KSTEP,NSTEP,METHOD,
     *    SSZ(15),1,1,1,
     *    1,1,1,
     *    SSZ(15),1,1,1,
     *    1,1,1,
     *    C00159,U00159,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "PINDB"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01332')
      RETURN
      END
      SUBROUTINE S01333(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00161,
     *  V00131,
     *  U00161,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00161(SSZ(1),SSZ(14))
      REAL V00131(SSZ(1),SSZ(14))
      REAL U00161(SSZ(1),SSZ(14))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2_L"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(14)
      DO 1 I00001=1,SSZ(1)
      U00161(I00001,I00002)=C00161(I00001,I00002)*
     *  (V00131(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00161),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(161),KSTEP,NSTEP,METHOD,
     *    SSZ(1),SSZ(14),1,1,
     *    1,1,1,
     *    SSZ(1),SSZ(14),1,1,
     *    1,1,1,
     *    C00161,U00161,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "CO2_L"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01333')
      RETURN
      END
      SUBROUTINE S01334(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00162,
     *  V00132,
     *  U00162,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00162(SSZ(1))
      REAL V00132(SSZ(1))
      REAL U00162(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "NOMCTAX_L"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(1)
      U00162(I00001)=V00132(I00001)
    1 CONTINUE
      CALL GPARW(SIZE(C00162),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(162),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00162,U00162,RWORK,.TRUE.,'c',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "NOMCTAX_L"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01334')
      RETURN
      END
      SUBROUTINE M00033(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,RTSIOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,NELTX,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c1
      USE gtap_u1
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL LDOWR,NELTX,RTSIOK
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOGICAL CPDOAC,CPDOAP
      COMMON/CPLOG1/ CPDOAC,CPDOAP
      DOUBLE PRECISION CPSLEN,CPSDON,CPSTOT
      COMMON /CPDBL2/ CPSLEN,CPSDON,CPSTOT
      LOGICAL CPSKAC
      COMMON /CPLOG7/CPSKAC
      INTEGER :: LDSPDEC,LDSPCPN,LDSPCLN
      LDOWR=(KSTEPA.EQ.NPASSA).AND.(.NOT.CPDOAP)
      IF(CPDOAP.AND.CPSKAC) LDOWR=(CPSTOT.EQ.1.0D0)
      LOWMEM=.FALSE.
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00031),U00031,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIMS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01303(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00032,
     *  V00030,V00031,
     *  U00032,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00032),U00032,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIWS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01304(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00033,
     *  V00031,V00032,
     *  U00033,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00033),U00033,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VXWD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01305(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00034,
     *  V00031,V00033,
     *  U00034,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00034),U00034,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VXMD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01306(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00035,
     *  V00005,V00031,
     *  U00035,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00035),U00035,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01307(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00036,
     *  V00005,V00034,
     *  U00036,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00036),U00036,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2DF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01308(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00037,
     *  V00035,
     *  U00037,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00037),U00037,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2IF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01309(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00038,
     *  V00036,
     *  U00038,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00038),U00038,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2DG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01310(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00039,
     *  V00037,
     *  U00039,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00039),U00039,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2IG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01311(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00040,
     *  V00038,
     *  U00040,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00040),U00040,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2DP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01312(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00041,
     *  V00039,
     *  U00041,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00041),U00041,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2IP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01313(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00042,
     *  V00040,
     *  U00042,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00042),U00042,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'NCTAXLEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01314(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,C00043,
     *  V00041,
     *  U00043,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VKB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01324(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00128,
     *  V00028,V00029,
     *  U00128,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00128),U00128,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VTMFSD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01328(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00135,
     *  V00106,V00115,
     *  U00135,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00135),U00135,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2Q',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01329(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00148,
     *  V00116,
     *  U00148,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00148),U00148,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      CALL TGSCRS('tg',0,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'PIND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01331(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00157,
     *  V00043,
     *  U00157,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'PINDB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01332(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00159,
     *  V00129,
     *  U00159,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2_L',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01333(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00161,
     *  V00131,
     *  U00161,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'NOMCTAX_L',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01334(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00162,
     *  V00132,
     *  U00162,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00033')
      RETURN
      END
      SUBROUTINE S01335(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00153,
     *  V00122,
     *  U00153,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00153(SSZ(1),SSZ(14))
      REAL V00122(SSZ(1),SSZ(14))
      REAL U00153(SSZ(1),SSZ(14))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(14)
      DO 1 I00001=1,SSZ(1)
      U00153(I00001,I00002)=V00122(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00153),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(153),KSTEP,NSTEP,METHOD,
     *    SSZ(1),SSZ(14),1,1,
     *    1,1,1,
     *    SSZ(1),SSZ(14),1,1,
     *    1,1,1,
     *    C00153,U00153,RWORK,.TRUE.,'c',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VCTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01335')
      RETURN
      END
      SUBROUTINE S01336(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00165,
     *  V00139,
     *  U00165,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00165(SSZ(1))
      REAL V00139(SSZ(1))
      REAL U00165(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "DPARSUM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00165(I00002)=C00165(I00002)*(V00139(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00165),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(165),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00165,U00165,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "DPARSUM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01336')
      RETURN
      END
      SUBROUTINE S01337(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00170,
     *  V00053,
     *  U00170,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00170(SSZ(1))
      REAL V00053(SSZ(1))
      REAL U00170(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00170(I00002)=C00170(I00002)*(V00053(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00170),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(170),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00170,U00170,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILPRIV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01337')
      RETURN
      END
      SUBROUTINE S01338(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00171,
     *  V00049,
     *  U00171,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00171(SSZ(1))
      REAL V00049(SSZ(1))
      REAL U00171(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00171(I00002)=C00171(I00002)*(V00049(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00171),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(171),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00171,U00171,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILGOV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01338')
      RETURN
      END
      SUBROUTINE S01339(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00172,
     *  V00002,V00044,
     *  U00172,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00172(SSZ(1))
      REAL V00002(SSZ(1))
      REAL V00044(SSZ(1))
      REAL U00172(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00172(I00002)=((V00002(I00002)-V00044(I00002))/100.)*
     *  C00172(I00002)
    1 CONTINUE
      CALL GPARW(SIZE(C00172),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(172),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00172,U00172,RWORK,.TRUE.,'c',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILSAVE"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01339')
      RETURN
      END
      SUBROUTINE S01340(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00200,
     *  V00195,
     *  U00200,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00200(SSZ(1))
      REAL V00195(SSZ(1))
      REAL U00200(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "INCOMEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00200(I00002)=C00200(I00002)*(V00195(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00200),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(200),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00200,U00200,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "INCOMEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01340')
      RETURN
      END
      SUBROUTINE S01341(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00201,
     *  V00193,
     *  U00201,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00201(SSZ(1))
      REAL V00193(SSZ(1))
      REAL U00201(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00201(I00002)=C00201(I00002)*(V00193(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00201),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(201),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00201,U00201,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILPRIVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01341')
      RETURN
      END
      SUBROUTINE S01342(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00202,
     *  V00192,
     *  U00202,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00202(SSZ(1))
      REAL V00192(SSZ(1))
      REAL U00202(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00202(I00002)=C00202(I00002)*(V00192(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00202),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(202),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00202,U00202,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILGOVEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01342')
      RETURN
      END
      SUBROUTINE S01343(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00203,
     *  V00044,V00194,
     *  U00203,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00203(SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00194(SSZ(1))
      REAL U00203(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00203(I00002)=((V00194(I00002)-V00044(I00002))/100.)*
     *  C00203(I00002)
    1 CONTINUE
      CALL GPARW(SIZE(C00203),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(203),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00203,U00203,RWORK,.TRUE.,'c',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILSAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01343')
      RETURN
      END
      SUBROUTINE S01344(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00204,
     *  V00198,
     *  U00204,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00204(SSZ(2),SSZ(1))
      REAL V00198(SSZ(2),SSZ(1))
      REAL U00204(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VPAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(2)
      U00204(I00001,I00002)=C00204(I00001,I00002)*
     *  (V00198(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00204),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(204),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00204,U00204,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "VPAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01344')
      RETURN
      END
      SUBROUTINE S01345(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00210,
     *  V00196,
     *  U00210,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00210(SSZ(1))
      REAL V00196(SSZ(1))
      REAL U00210(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "PRIVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00210(I00002)=C00210(I00002)*(V00196(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00210),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(210),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00210,U00210,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "PRIVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01345')
      RETURN
      END
      SUBROUTINE S01346(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00211,
     *  V00197,
     *  U00211,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00211(SSZ(1))
      REAL V00197(SSZ(1))
      REAL U00211(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "GOVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00211(I00002)=C00211(I00002)*(V00197(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00211),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(211),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00211,U00211,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "GOVEXPEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01346')
      RETURN
      END
      SUBROUTINE S01347(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00212,
     *  V00199,
     *  U00212,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00212(SSZ(1))
      REAL V00199(SSZ(1))
      REAL U00212(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "SAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00212(I00002)=C00212(I00002)*(V00199(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00212),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(212),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00212,U00212,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "SAVEEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01347')
      RETURN
      END
      SUBROUTINE S01348(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00216,
     *  V00190,
     *  U00216,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00216(SSZ(1))
      REAL V00190(SSZ(1))
      REAL U00216(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILELASEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)
      U00216(I00002)=C00216(I00002)*(V00190(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00216),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(216),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00216,U00216,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(IER.NE.0) THEN
        CALL TGIER('ud',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating update of coefficient "UTILELASEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01348')
      RETURN
      END
      SUBROUTINE M00034(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,RTSIOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,NELTX,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c1
      USE gtap_u1
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL LDOWR,NELTX,RTSIOK
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOGICAL CPDOAC,CPDOAP
      COMMON/CPLOG1/ CPDOAC,CPDOAP
      DOUBLE PRECISION CPSLEN,CPSDON,CPSTOT
      COMMON /CPDBL2/ CPSLEN,CPSDON,CPSTOT
      LOGICAL CPSKAC
      COMMON /CPLOG7/CPSKAC
      INTEGER :: LDSPDEC,LDSPCPN,LDSPCLN
      LDOWR=(KSTEPA.EQ.NPASSA).AND.(.NOT.CPDOAP)
      IF(CPDOAP.AND.CPSKAC) LDOWR=(CPSTOT.EQ.1.0D0)
      LOWMEM=.FALSE.
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VCTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01335(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00153,
     *  V00122,
     *  U00153,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'DPARSUM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01336(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00165,
     *  V00139,
     *  U00165,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILPRIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01337(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00170,
     *  V00053,
     *  U00170,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILGOV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01338(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00171,
     *  V00049,
     *  U00171,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILSAVE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01339(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00172,
     *  V00002,V00044,
     *  U00172,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'INCOMEEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01340(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00200,
     *  V00195,
     *  U00200,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILPRIVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01341(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00201,
     *  V00193,
     *  U00201,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILGOVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01342(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00202,
     *  V00192,
     *  U00202,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILSAVEEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01343(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00203,
     *  V00044,V00194,
     *  U00203,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VPAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01344(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00204,
     *  V00198,
     *  U00204,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'PRIVEXPEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01345(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00210,
     *  V00196,
     *  U00210,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'GOVEXPEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01346(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00211,
     *  V00197,
     *  U00211,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'SAVEEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01347(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00212,
     *  V00199,
     *  U00212,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILELASEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01348(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00216,
     *  V00190,
     *  U00216,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00034')
      RETURN
      END
      SUBROUTINE GPEQN1(EQNUM,CHAR,LCHAR,ERRMES)
      use gsinc1
      use gsinc3
      use gsinc5
      INTEGER EQNUM,LCHAR
      CHARACTER*(*) CHAR,ERRMES
      CALL GPEQN0(EQNUM,
     *  .TRUE.,MMNST,NUMST,SSZ,STELST,ELAD,.TRUE.,MMEL,STEL,
     *  .TRUE.,MMNEQ,NUMEQ,EQNAM,EQNIND,EQSTAT,.TRUE.,
     *  DEQSTN,EQSTN,CHAR,LCHAR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('GPEQN1')
      RETURN
      END
      include 'tgrwcv1.for'
      USE gtap_c3
      USE gtap_c4
      include 'tgrwcv2.for'
      include 'tgwdwk1.for'
      USE gtap_c3
      include 'tgwdwk2.for'
      include 'tgscrs1.for'
      USE gtap_c3
      USE gtap_c4
      USE gtap_u2
      include 'tgscrs2.for'
      include 'tgst1.for'
      USE gtap_c3
      include 'tgst2.for'
      include 'tgwacv1.for'
      USE gtap_c3
      include 'tgwacv2.for'
      include 'tgwcvv1.for'
      USE gtap_c3
      include 'tgwcvv2.for'
      include 'tgctri1.for'
      USE gtap_c3
      include 'tgctri2.for'
      include 'tgutv1.for'
      USE gtap_u2
      include 'tgutv2.for'
      include 'ssrsmv1.for'
      USE gtap_c3
      include 'ssrsmv2.for'
      include 'tgpmp1.for'
      USE gtap_c4
      include 'tgpmp2.for'
      include 'cmchsh1.for'
      USE gtap_c3
      include 'cmchsh2.for'
      include 'tbsstp1.for'
      USE gsinc5
      include 'tbsstp2.for'
      include 'tbsssp1.for'
      USE gsinc5
      include 'tbsssp2.for'
      include 'tbscsp1.for'
      USE gsinc1
      include 'tbscsp2.for'
