      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 07-MAR-2008 (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            SAVE
C         C00009            VDGA
C         C00010            VDGM
C         C00011            VIGA
C         C00012            VIGM
C         C00013            VDPA
C         C00014            VDPM
C         C00015            VIPA
C         C00016            VIPM
C         C00017            EVOA
C         C00018            EVFA
C         C00019            VDFA
C         C00020            VIFA
C         C00021            VFM
C         C00022            VIFM
C         C00023            VDFM
C         C00024            VDEP
C         C00025            VIMS
C         C00026            VIWS
C         C00027            VXWD
C         C00028            VXMD
C         C00029            VST
C         C00030            VFA
C         C00031            VOA
C         C00032            VDM
C         C00033            VOM
C         C00034            VGA
C         C00035            GOVEXP
C         C00036            VPA
C         C00037            PRIVEXP
C         C00038            INCOME
C         C00039            DGTAX
C         C00040            IGTAX
C         C00041            TGC
C         C00042            DPTAX
C         C00043            IPTAX
C         C00044            TPC
C         C00045            DFTAX
C         C00046            IFTAX
C         C00047            TIU
C         C00048            ETAX
C         C00049            TFU
C         C00050            PTAX
C         C00051            TOUT
C         C00052            XTAXD
C         C00053            TEX
C         C00054            MTAX
C         C00055            TIM
C         C00056            ESUBD
C         C00057            REGINV
C         C00058            NETINV
C         C00059            GLOBINV
C         C00060            CONSHR
C         C00061            GMSHR
C         C00062            AGGCOMNO
C         C00063            COMTOAGGCOM
C         C00064            aPP
C         C00065            aQP
C         C00066            aUCONS
C         C00067            aALPHA
C         C00068            aBETA
C         C00069            aGAMMA
C         C00070            aKAPPA
C         C00071            aPHI
C         C00072            aEPSIN
C         C00073            aABSHARE
C         C00074            aMBSHARE
C         C00075            aAPE
C         C00076            aAPEii
C         C00077            aEY
C         C00078            aEP
C         C00079            aEXPUCONS
C         C00080            AGGMATRIX
C         C00081            VPASG
C         C00082            VPAP
C         C00083            VPAC
C         C00084            ESUBAGG
C         C00085            PMSHR
C         C00086            ESUBT
C         C00087            SPI
C         C00088            SPIL
C         C00089            ESUBPURCH
C         C00090            ESUBFS
C         C00091            SFS
C         C00092            VVA
C         C00093            SVADEFAULT
C         C00094            SVA
C         C00095            ESUBVA
C         C00096            FMSHR
C         C00097            STC
C         C00098            VKB
C         C00099            INVKERATIO
C         C00100            GRNETRATIO
C         C00101            RORFLEX
C         C00102            RORDELTA
C         C00103            MSHRS
C         C00104            ESUBM
C         C00105            VTMFSD
C         C00106            VTFSD
C         C00107            VTMUSE
C         C00108            VTMPROV
C         C00109            VTRPROV
C         C00110            VT
C         C00111            VTMUSESHR
C         C00112            VTSUPPSHR
C         C00113            VTUSE
C         C00114            VTFSD_MSH
C         C00115            VIWSCOST
C         C00116            FOBSHR
C         C00117            TRNSHR
C         C00118            TINC
C         C00119            REVSHR
C         C00120            ETRAE
C         C00121            FY
C         C00122            INDTAX
C         C00123            SHRDFM
C         C00124            SHRDPM
C         C00125            SHRDGM
C         C00126            SHRDM
C         C00127            SHRST
C         C00128            SHRXMD
C         C00129            VIM
C         C00130            SHRIFM
C         C00131            SHRIPM
C         C00132            SHRIGM
C         C00133            VOMAGR
C         C00134            VOMNAGR
C         C00135            ETRAEAGNAG
C         C00136            VXW
C         C00137            VXWREGION
C         C00138            VIW
C         C00139            VIWREGION
C         C00140            VENDWREG
C         C00141            VENDWWLD
C         C00142            GDP
C         C00143            VXWCOMMOD
C         C00144            VXWLD
C         C00145            VIWCOMMOD
C         C00146            PW_PM
C         C00147            VOW
C         C00148            VWOW
C         C00149            VWOU
C         C00150            TBAL
C         C00151            SX_IR
C         C00152            VTICOMM
C         C00153            VIWDIRALL
C         C00154            VIWDATOT
C         C00155            SM_IR
C         C00156            SX_IRS
C         C00157            SXT_IR
C         C00158            SM_IRS
C         C00159            SMT_IR
C         C00160            SW_IR
C         C00161            SW_I
C         C00162            FCAPSHR
C         C00163            FVDEP
C         C00164            GAMMA
C         C00165            FYHHLDSHR
C         C00166            FVA
C         C00167            NFVA
C         C00168            NFVOA
C         C00169            NFVOM
C         C00170            NFCAPSHR
C         C00171            NFVDEP
C         C00172            FFY
C         C00173            FFYON
C         C00174            FFYOFF
C         C00175            FINDTAX
C         C00176            FINDTAXON
C         C00177            FINDTAXOFF
C         C00178            FARMINCOME
C         C00179            FARMINCOMEON
C         C00180            FINCOMEOFF
C         C00181            TFARMINC
C         C00182            AggShr
C         C00183            AGFARMINC
C         C00184            DAggShr
C         C00185            DAGFARMINC
C         C00186            FFshrrice
C         C00187            FFshrsug
C         C00188            FFshrcot
C         C00189            FFshrdry
C         C00190            FFshroth
C         C00191            FFshr
C         C00192            FFINC
C         C00193            LSRic
C         C00194            LSSug
C         C00195            LSCot
C         C00196            LSDai
C         C00197            LSOth
C         C00198            LandShrI
C         C00199            FLINC
C         C00200            FarmInc
C         C00201            FIshrt
C         C00202            OFarmInc
C         C00203            OFacshrric
C         C00204            OFacshrsug
C         C00205            OFacshrcot
C         C00206            OFacshrdai
C         C00207            OFacshroth
C         C00208            OFacshr
C         C00209            OFFInc
C         C00210            usFCAPSHR
C         C00211            usFVDEP
C         C00212            usNFCAPSHR
C         C00213            usNFVDEP
C         C00214            usFFY
C         C00215            usFFYON
C         C00216            usFFYOFF
C         C00217            usFINDTAX
C         C00218            usFINDTAXON
C         C00219            usFINDTAXOFF
C         C00220            usFARMINCOME
C         C00221            usFARMINCON
C         C00222            usFINCOMEOFF
C         C00223            aUCONSUSA
C         C00224            aQUSA
C         C00225            aPHIUSA
C         C00226            aEPSINUSA
C         C00227            aABSHAREUSA
C         C00228            aMBSHAREUSA
C         C00229            aAPEUSA
C         C00230            aAPEiiUSA
C         C00231            aEYUSA
C         C00232            aEPUSA
C         C00233            aPP0
C         C00234            aQUSAEV
C         C00235            aPHIUSAEV
C         C00236            aEPSINUSAEV
C         C00237            aABSHRUSAEV
C         C00238            aMBSHRUSAEV
C         C00239            aEYUSAEV
C         C00240            aUCONSUP
C         C00241            aQPUP
C         C00242            aPHIUP
C         C00243            aEPSINUP
C         C00244            aABSHAREUP
C         C00245            aMBSHAREUP
C         C00246            aAPEUP
C         C00247            aAPEiiUP
C         C00248            aEYUP
C         C00249            aEPUP
C         C00250            STRATHCOUNT
C         C00251            REGHCOUNT
C         C00252            POVELAST
C         C00253            PINCTAX
C         C00254            POVSHR
C         C00255            TOTPOVELAST
C         C00256            TAXPOVELAST
C         C00257            NATLPOVELAST
C         C00258            NATLTAXELAST
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
C Declarations of all coefficients
C      REAL C00001(1),C00002(1),C00003(1),C00004(1),C00005(1),C00006(1)
C      INTEGER C00007(0)
C      REAL C00008(0),C00009(0,0),C00010(0,0),C00011(0,0),C00012(0,0)
C      REAL C00013(0,0),C00014(0,0),C00015(0,0),C00016(0,0),C00017(0,0)
C      REAL C00018(0,0,0),C00019(0,0,0),C00020(0,0,0),C00021(0,0,0)
C      REAL C00022(0,0,0),C00023(0,0,0),C00024(0),C00025(0,0,0)
C      REAL C00026(0,0,0),C00027(0,0,0),C00028(0,0,0),C00029(0,0)
C      REAL C00030(0,0,0),C00031(0,0),C00032(0,0),C00033(0,0)
C      REAL C00034(0,0),C00035(0),C00036(0,0),C00037(0),C00038(0)
C      REAL C00039(0,0),C00040(0,0),C00041(0),C00042(0,0),C00043(0,0)
C      REAL C00044(0),C00045(0,0,0),C00046(0,0,0),C00047(0)
C      REAL C00048(0,0,0),C00049(0),C00050(0,0),C00051(0),C00052(0,0,0)
C      REAL C00053(0),C00054(0,0,0),C00055(0),C00056(0),C00057(0)
C      REAL C00058(0),C00059(1),C00060(0,0),C00061(0,0)
C      INTEGER C00062(0),C00063(0)
C      REAL C00064(0,0),C00065(0,0),C00066(0),C00067(0,0),C00068(0,0)
C      REAL C00069(0,0),C00070(0),C00071(0,0),C00072(0),C00073(0,0)
C      REAL C00074(0,0),C00075(0,0,0),C00076(0,0),C00077(0,0)
C      REAL C00078(0,0,0),C00079(0),C00080(0,0),C00081(0,0,0)
C      REAL C00082(0,0),C00083(0,0),C00084(0),C00085(0,0),C00086(0,0)
C      REAL C00087(0,0,0),C00088(0,0,0),C00089(0,0),C00090(0,0)
C      REAL C00091(0,0,0),C00092(0,0),C00093(0),C00094(0,0,0)
C      REAL C00095(0,0),C00096(0,0,0),C00097(0,0,0),C00098(0),C00099(0)
C      REAL C00100(0),C00101(0)
C      INTEGER C00102(1)
C      REAL C00103(0,0,0),C00104(0),C00105(0,0,0,0),C00106(0,0,0)
C      REAL C00107(0),C00108(0),C00109(0),C00110(1),C00111(0,0,0,0)
C      REAL C00112(0,0),C00113(1),C00114(0,0,0,0),C00115(0,0,0)
C      REAL C00116(0,0,0),C00117(0,0,0),C00118(0),C00119(0,0,0)
C      REAL C00120(0,0),C00121(0),C00122(0),C00123(0,0,0),C00124(0,0)
C      REAL C00125(0,0),C00126(0,0),C00127(0,0),C00128(0,0,0)
C      REAL C00129(0,0),C00130(0,0,0),C00131(0,0),C00132(0,0)
C      REAL C00133(0,0),C00134(0,0),C00135(0,0),C00136(0,0),C00137(0)
C      REAL C00138(0,0),C00139(0),C00140(0),C00141(1),C00142(0)
C      REAL C00143(0),C00144(1),C00145(0),C00146(0,0),C00147(0,0)
C      REAL C00148(0),C00149(0),C00150(0),C00151(0,0),C00152(0,0)
C      REAL C00153(0,0),C00154(0),C00155(0,0),C00156(0,0,0),C00157(0,0)
C      REAL C00158(0,0,0),C00159(0,0),C00160(0,0),C00161(0),C00162(0)
C      REAL C00163(0),C00164(0,0),C00165(0),C00166(0),C00167(0)
C      REAL C00168(0,0),C00169(0,0),C00170(0),C00171(0),C00172(0)
C      REAL C00173(0),C00174(0),C00175(0),C00176(0),C00177(0),C00178(0)
C      REAL C00179(0),C00180(0),C00181(0),C00182(0),C00183(0,0)
C      REAL C00184(0,0),C00185(0,0,0),C00186(0,0,0),C00187(0,0,0)
C      REAL C00188(0,0,0),C00189(0,0,0),C00190(0,0,0),C00191(0,0,0,0)
C      REAL C00192(0,0,0,0),C00193(0,0,0),C00194(0,0,0),C00195(0,0,0)
C      REAL C00196(0,0,0),C00197(0,0,0),C00198(0,0,0,0)
C      REAL C00199(0,0,0,0,0),C00200(0,0,0),C00201(0,0,0),C00202(0,0,0)
C      REAL C00203(0,0,0),C00204(0,0,0),C00205(0,0,0),C00206(0,0,0)
C      REAL C00207(0,0,0),C00208(0,0,0,0),C00209(0,0,0,0),C00210(0,0,0)
C      REAL C00211(0,0,0),C00212(0,0,0),C00213(0,0,0),C00214(0,0,0)
C      REAL C00215(0,0,0),C00216(0,0,0),C00217(0,0,0),C00218(0,0,0)
C      REAL C00219(0,0,0),C00220(0,0,0),C00221(0,0,0),C00222(0,0,0)
C      REAL C00223(0,0,0),C00224(0,0,0,0),C00225(0,0,0,0),C00226(0,0,0)
C      REAL C00227(0,0,0,0),C00228(0,0,0,0),C00229(0,0,0,0,0)
C      REAL C00230(0,0,0,0),C00231(0,0,0,0),C00232(0,0,0,0,0)
C      REAL C00233(0,0),C00234(0,0,0,0),C00235(0,0,0,0),C00236(0,0,0)
C      REAL C00237(0,0,0,0),C00238(0,0,0,0),C00239(0,0,0,0),C00240(0,0)
C      REAL C00241(0,0,0),C00242(0,0,0),C00243(0,0),C00244(0,0,0)
C      REAL C00245(0,0,0),C00246(0,0,0,0),C00247(0,0,0),C00248(0,0,0)
C      REAL C00249(0,0,0,0),C00250(0,0,0),C00251(0,0),C00252(0,0,0,0)
C      INTEGER C00253(1)
C      REAL C00254(0,0,0),C00255(0,0,0),C00256(0,0,0),C00257(0,0)
C      REAL C00258(0,0),C00259(0),C00260(0,0),C00261(0,0),C00262(0,0)
C      REAL C00263(0,0),C00264(0),C00265(0,0),C00266(0,0),C00267(0,0)
C      REAL C00268(0,0),C00269(0,0),C00270(0,0),C00271(0,0),C00272(0,0)
C      REAL C00273(0,0),C00274(0,0),C00275(0,0),C00276(0,0),C00277(0,0)
C      REAL C00278(0,0),C00279(0,0),C00280(0,0),C00281(0,0),C00282(0,0)
C      REAL C00283(0,0),C00284(0,0),C00285(0,0),C00286(0,0,0)
C      REAL C00287(0,0,0),C00288(0,0,0),C00289(0,0),C00290(0,0)
C      REAL C00291(0,0),C00292(0,0),C00293(0,0),C00294(0),C00295(0,0)
C      REAL C00296(0,0),C00297(0,0),C00298(0,0),C00299(0,0),C00300(0,0)
C      REAL C00301(0),C00302(0,0,0),C00303(0,0,0),C00304(0,0,0)
C      REAL C00305(0,0),C00306(0,0,0),C00307(0,0),C00308(0,0)
C      REAL C00309(0,0),C00310(0,0,0),C00311(0,0),C00312(0,0)
C      REAL C00313(0,0),C00314(0,0),C00315(0,0),C00316(0,0,0)
C      REAL C00317(0,0),C00318(0,0),C00319(0),C00320(0,0),C00321(0,0)
C      REAL C00322(0,0),C00323(0),C00324(0,0,0),C00325(0,0,0)
C      REAL C00326(0,0,0),C00327(0,0,0),C00328(0,0),C00329(0,0)
C      REAL C00330(0,0),C00331(0,0),C00332(0,0),C00333(0,0),C00334(0,0)
C      REAL C00335(0,0),C00336(0,0),C00337(0,0),C00338(0,0),C00339(0,0)
C      REAL C00340(0,0),C00341(0,0),C00342(0,0),C00343(0,0),C00344(0)
C      REAL C00345(0,0),C00346(0,0),C00347(0,0),C00348(0,0,0)
C      REAL C00349(0,0,0),C00350(0,0),C00351(0,0,0),C00352(0,0)
C      REAL C00353(0,0),C00354(0,0),C00355(0,0),C00356(0),C00357(0,0)
C      REAL C00358(0,0),C00359(0,0),C00360(0,0),C00361(0),C00362(0,0)
C      REAL C00363(0,0),C00364(0,0),C00365(0,0),C00366(0),C00367(0,0)
C      REAL C00368(0,0,0),C00369(0,0),C00370(0,0,0),C00371(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            h
C         I00007            k
C         I00009            z
C         I00010            l
C         I00011            e
C         I00012            a
C         I00013            c
C         I00014            d
C         I00015            p
C         I00016            XX01
C         I00017            SS01
      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
      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
      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 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
      CALL M00012(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 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 M00029(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 M00030(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 M00031(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  CWKUN,
     *  FSTPAS,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00032(
     *  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 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
      CALL M00035(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 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(59,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(102,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(110,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(113,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(144,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
      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(24,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(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(41,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(44,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(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(53,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(57,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(66,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) THEN
       CALL SSAL1C(72,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(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(109,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(122,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(139,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(142,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(154,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(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(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(173,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(177,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(180,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(264,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(301,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(323,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(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(371,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(181,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=2
       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(182,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(183,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(184,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(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(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(218,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(220,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(222,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(226,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(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(327,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(9,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      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(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(32,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(36,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(42,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(52,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(56,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(85,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(103,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(106,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(116,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(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(126,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(131,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(136,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(143,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(148,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(151,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(153,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(156,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(160,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) THEN
       CALL SSAL1C(260,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(263,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(272,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(276,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(328,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(333,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(343,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(350,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(359,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(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(29,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(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(112,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(127,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(157,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(335,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(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(344,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(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(349,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(353,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(358,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(363,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(368,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.OR.POSTSIMPASS2) THEN
       LITSN=6
       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
      IF(PRELIM) THEN
       CALL SSAL1C(337,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(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.OR.POSTSIMPASS2) THEN
       LITSN=7
       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
      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(17,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(120,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(186,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(189,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(191,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
      IF(PRELIM) THEN
       CALL SSAL1C(203,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(205,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(208,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(320,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(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(22,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(23,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(45,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(86,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(92,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(119,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(130,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(269,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(282,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(288,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(300,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.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
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=8
       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
      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(30,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.OR.POSTSIMPASS2) THEN
       LITSN=9
       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
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=5
       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
      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(31,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(50,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=11
       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=8
       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(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(313,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
      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=14
       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) THEN
       CALL SSAL1C(87,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(198,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(199,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(283,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(298,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(314,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(316,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(322,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.OR.POSTSIMPASS2) THEN
       LITSN=15
       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(281,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(287,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(299,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.OR.POSTSIMPASS2) THEN
       LITSN=16
       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.OR.POSTSIMPASS2) THEN
       LITSN=17
       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.OR.POSTSIMPASS2) THEN
       LITSN=18
       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
      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=15
       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(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=17
       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(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
      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=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
      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(88,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(268,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      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
      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(266,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
      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(91,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      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
      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=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
      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
      RETURN
15000 CALL PERET('M00001')
      RETURN
      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(5)
      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(9)
      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(11)
      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',64,
     *' ',
     *   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(8)
      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(10)
      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',69,
     *' ',
     *   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(9))
      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(26)=NSSMP+1
        CALL TGINCP(NSSMP+SSZ(9),DSSMP,'DSSMP',ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      DO 1 I00001=1,SSZ(9)
      RS1=0.0
      LG1=C00007(I00001).GT.0
      IF(LG1) THEN
      RS1=1
      END IF
      SSMP(SSMPST(26)-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 S00009(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00018,C00030,
     *  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 C00018(SSZ(9),SSZ(10),SSZ(1))
      REAL C00030(SSZ(11),SSZ(10),SSZ(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(10)
      DO 1 I00001=1,SSZ(9)
      C00030(SSMP(SSMPST(6)-1+I00001),I00004,I00002)=
     *  C00018(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('S00009')
      RETURN
      END
      SUBROUTINE S00010(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00019,C00020,C00030,
     *  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 C00019(SSZ(5),SSZ(10),SSZ(1))
      REAL C00020(SSZ(5),SSZ(10),SSZ(1))
      REAL C00030(SSZ(11),SSZ(10),SSZ(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 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(10)
      DO 1 I00001=1,SSZ(5)
      C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)=
     *  C00019(I00001,I00004,I00003)+C00020(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 "VFA"',
     *  ' ',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,
     *  C00017,C00031,
     *  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(9),SSZ(1))
      REAL C00031(SSZ(12),SSZ(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(9)
      C00031(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+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 "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,
     *  C00030,C00031,
     *  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 C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00031(SSZ(12),SSZ(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(10)
      RS1=0.0
      DO 3 I00004=1,SSZ(11)
      RS1=RS1+C00030(I00004,I00001,I00002)
    3 CONTINUE
      C00031(SSMP(SSMPST(10)-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,
     *  C00010,C00014,C00023,C00032,
     *  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(5),SSZ(1))
      REAL C00014(SSZ(5),SSZ(1))
      REAL C00023(SSZ(5),SSZ(10),SSZ(1))
      REAL C00032(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1+C00023(I00001,I00004,I00002)
    3 CONTINUE
      C00032(I00001,I00002)=C00014(I00001,I00002)+C00010(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,
     *  C00021,C00033,
     *  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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00033(SSZ(12),SSZ(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(9)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1+C00021(I00001,I00004,I00002)
    3 CONTINUE
      C00033(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-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,
     *  C00028,C00029,C00032,C00033,
     *  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 C00028(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00032(SSZ(5),SSZ(1))
      REAL C00033(SSZ(12),SSZ(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(6)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00028(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00033(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005))),I00002)=C00032(SSMP(SSMPST(2)-1+I00005),I00002)+RS1+
     *  C00029(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,
     *  C00028,C00032,C00033,
     *  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 C00028(SSZ(5),SSZ(1),SSZ(1))
      REAL C00032(SSZ(5),SSZ(1))
      REAL C00033(SSZ(12),SSZ(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(7)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00028(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00033(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(3)-1+
     *  I00001))),I00002)=C00032(SSMP(SSMPST(3)-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,
     *  C00031,C00033,
     *  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)
      LOGICAL ECHO1
      REAL C00031(SSZ(12),SSZ(1))
      REAL C00033(SSZ(12),SSZ(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 I00006=1,SSZ(8)
      C00033(SSMP(SSMPST(10)-1+SSMP(SSMPST(5)-1+I00006)),I00002)=
     *  C00031(SSMP(SSMPST(10)-1+SSMP(SSMPST(5)-1+I00006)),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,
     *  C00009,C00011,C00034,
     *  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 C00009(SSZ(5),SSZ(1))
      REAL C00011(SSZ(5),SSZ(1))
      REAL C00034(SSZ(5),SSZ(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(5)
      C00034(I00001,I00003)=C00009(I00001,I00003)+C00011(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 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 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=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(59).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_TRAD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(59).NE.'n') then
      CALL S00001(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(59),
     *  C00002,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(61).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_ENDW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(61).NE.'n') then
      CALL S00002(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(61),
     *  C00003,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(63).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_DEMD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(63).NE.'n') then
      CALL S00003(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(63),
     *  C00004,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(64).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(64).NE.'n') then
      CALL S00004(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(64),
     *  C00002,C00003,C00004,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ENDIF
      IF(ECHO1.AND.DOIG(66).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_CGDS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(66).NE.'n') then
      CALL S00005(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(66),
     *  C00005,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(68).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_PROD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(68).NE.'n') then
      CALL S00006(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(68),
     *  C00006,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(69).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(69).NE.'n') then
      CALL S00007(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(69),
     *  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(73).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(73).NE.'n') then
      CALL S00008(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(73),
     *  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) THEN
       CALL SSAL1C(297,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      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
      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(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(135,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(209,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) THEN
       CALL SSAL1C(296,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(308,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(310,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) THEN
       CALL SSAL1C(312,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
      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
      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=13
       SSNO=28
       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,28,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=29
       SSNO=29
       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,29,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 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(201).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(201).NE.'n') then
      CALL S00009(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(201),
     *  C00018,C00030,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(202).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(202).NE.'n') then
      CALL S00010(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(202),
     *  C00019,C00020,C00030,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(204).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(204).NE.'n') then
      CALL S00011(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(204),
     *  C00017,C00031,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(205).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(205).NE.'n') then
      CALL S00012(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(205),
     *  C00030,C00031,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(207).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VDM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(207).NE.'n') then
      CALL S00013(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(207),
     *  C00010,C00014,C00023,C00032,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(209).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(209).NE.'n') then
      CALL S00014(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(209),
     *  C00021,C00033,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(210).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(210).NE.'n') then
      CALL S00015(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(210),
     *  C00028,C00029,C00032,C00033,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(211).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(211).NE.'n') then
      CALL S00016(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(211),
     *  C00028,C00032,C00033,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(212).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(212).NE.'n') then
      CALL S00017(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(212),
     *  C00031,C00033,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(214).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VGA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(214).NE.'n') then
      CALL S00018(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(214),
     *  C00009,C00011,C00034,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00002')
      RETURN
      END
      SUBROUTINE S00019(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00035,
     *  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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(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(5)
      RS1=RS1+C00034(I00001,I00002)
    2 CONTINUE
      C00035(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,
     *  C00013,C00015,C00036,
     *  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 C00013(SSZ(5),SSZ(1))
      REAL C00015(SSZ(5),SSZ(1))
      REAL C00036(SSZ(5),SSZ(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(5)
      C00036(I00001,I00003)=C00013(I00001,I00003)+C00015(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,
     *  C00036,C00037,
     *  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 C00036(SSZ(5),SSZ(1))
      REAL C00037(SSZ(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(5)
      RS1=RS1+C00036(I00001,I00002)
    2 CONTINUE
      C00037(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,
     *  C00008,C00035,C00037,C00038,
     *  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 C00008(SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00037(SSZ(1))
      REAL C00038(SSZ(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)
      C00038(I00002)=C00037(I00002)+C00035(I00002)+C00008(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,
     *  C00009,C00010,C00039,
     *  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 C00009(SSZ(5),SSZ(1))
      REAL C00010(SSZ(5),SSZ(1))
      REAL C00039(SSZ(5),SSZ(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(5)
      C00039(I00001,I00002)=C00009(I00001,I00002)-C00010(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('S00023')
      RETURN
      END
      SUBROUTINE S00024(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00011,C00012,C00040,
     *  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(5),SSZ(1))
      REAL C00012(SSZ(5),SSZ(1))
      REAL C00040(SSZ(5),SSZ(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(5)
      C00040(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 "IGTAX"',
     *  ' ',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,
     *  C00039,C00040,C00041,
     *  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 C00039(SSZ(5),SSZ(1))
      REAL C00040(SSZ(5),SSZ(1))
      REAL C00041(SSZ(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(5)
      RS1=RS1+C00039(I00001,I00002)+C00040(I00001,I00002)
    2 CONTINUE
      C00041(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('S00025')
      RETURN
      END
      SUBROUTINE S00026(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00013,C00014,C00042,
     *  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(5),SSZ(1))
      REAL C00014(SSZ(5),SSZ(1))
      REAL C00042(SSZ(5),SSZ(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(5)
      C00042(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 "DPTAX"',
     *  ' ',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,
     *  C00015,C00016,C00043,
     *  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 C00015(SSZ(5),SSZ(1))
      REAL C00016(SSZ(5),SSZ(1))
      REAL C00043(SSZ(5),SSZ(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(5)
      C00043(I00001,I00002)=C00015(I00001,I00002)-C00016(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('S00027')
      RETURN
      END
      SUBROUTINE S00028(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00042,C00043,C00044,
     *  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 C00042(SSZ(5),SSZ(1))
      REAL C00043(SSZ(5),SSZ(1))
      REAL C00044(SSZ(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(5)
      RS1=RS1+C00042(I00001,I00002)+C00043(I00001,I00002)
    2 CONTINUE
      C00044(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('S00028')
      RETURN
      END
      SUBROUTINE S00029(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00019,C00023,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)
      LOGICAL ECHO1
      REAL C00019(SSZ(5),SSZ(10),SSZ(1))
      REAL C00023(SSZ(5),SSZ(10),SSZ(1))
      REAL C00045(SSZ(5),SSZ(10),SSZ(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(10)
      DO 1 I00001=1,SSZ(5)
      C00045(I00001,I00004,I00002)=C00019(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 "DFTAX"',
     *  ' ',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,C00022,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)
      LOGICAL ECHO1
      REAL C00020(SSZ(5),SSZ(10),SSZ(1))
      REAL C00022(SSZ(5),SSZ(10),SSZ(1))
      REAL C00046(SSZ(5),SSZ(10),SSZ(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(10)
      DO 1 I00001=1,SSZ(5)
      C00046(I00001,I00004,I00002)=C00020(I00001,I00004,I00002)-
     *  C00022(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('S00030')
      RETURN
      END
      SUBROUTINE S00031(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00045,C00046,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,RS2
      LOGICAL ECHO1
      REAL C00045(SSZ(5),SSZ(10),SSZ(1))
      REAL C00046(SSZ(5),SSZ(10),SSZ(1))
      REAL C00047(SSZ(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 3 I00004=1,SSZ(10)
      RS2=0.0
      DO 2 I00001=1,SSZ(5)
      RS2=RS2+C00045(I00001,I00004,I00002)+C00046(I00001,I00004,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00047(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('S00031')
      RETURN
      END
      SUBROUTINE S00032(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00030,C00048,
     *  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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00048(SSZ(9),SSZ(10),SSZ(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(10)
      DO 1 I00001=1,SSZ(9)
      C00048(I00001,I00004,I00002)=C00030(SSMP(SSMPST(6)-1+
     *  I00001),I00004,I00002)-C00021(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('S00032')
      RETURN
      END
      SUBROUTINE S00033(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 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 C00048(SSZ(9),SSZ(10),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 "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(10)
      RS2=0.0
      DO 2 I00001=1,SSZ(9)
      RS2=RS2+C00048(I00001,I00004,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 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 "TFU"',
     *  ' ',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,
     *  C00031,C00033,C00050,
     *  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 C00031(SSZ(12),SSZ(1))
      REAL C00033(SSZ(12),SSZ(1))
      REAL C00050(SSZ(12),SSZ(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(12)
      C00050(I00001,I00002)=C00033(I00001,I00002)-C00031(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('S00034')
      RETURN
      END
      SUBROUTINE S00035(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(12),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 "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(10)
      RS1=RS1+C00050(SSMP(SSMPST(10)-1+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 "TOUT"',
     *  ' ',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,
     *  C00027,C00028,C00052,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00028(SSZ(5),SSZ(1),SSZ(1))
      REAL C00052(SSZ(5),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(5)
      C00052(I00001,I00002,I00003)=C00027(I00001,I00002,I00003)-
     *  C00028(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('S00036')
      RETURN
      END
      SUBROUTINE S00037(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00052,C00053,
     *  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 C00052(SSZ(5),SSZ(1),SSZ(1))
      REAL C00053(SSZ(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(5)
      RS2=RS2+C00052(I00001,I00002,I00003)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00053(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('S00037')
      RETURN
      END
      SUBROUTINE S00038(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00025,C00026,C00054,
     *  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 C00025(SSZ(5),SSZ(1),SSZ(1))
      REAL C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00054(SSZ(5),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(5)
      C00054(I00001,I00002,I00003)=C00025(I00001,I00002,I00003)-
     *  C00026(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('S00038')
      RETURN
      END
      SUBROUTINE S00039(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00054,C00055,
     *  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 C00054(SSZ(5),SSZ(1),SSZ(1))
      REAL C00055(SSZ(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(5)
      RS2=RS2+C00054(I00001,I00003,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00055(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('S00039')
      RETURN
      END
      SUBROUTINE S00040(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00031,C00057,
     *  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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00031(SSZ(12),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 "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 I00007=1,SSZ(8)
      RS1=RS1+C00031(SSMP(SSMPST(10)-1+SSMP(SSMPST(5)-1+I00007)),I00002)
    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 "REGINV"',
     *  ' ',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,
     *  C00024,C00031,C00058,
     *  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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00024(SSZ(1))
      REAL C00031(SSZ(12),SSZ(1))
      REAL C00058(SSZ(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 I00007=1,SSZ(8)
      RS1=RS1+C00031(SSMP(SSMPST(10)-1+SSMP(SSMPST(5)-1+I00007)),I00002)
    2 CONTINUE
      C00058(I00002)=RS1-C00024(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('S00041')
      RETURN
      END
      SUBROUTINE S00042(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00058,C00059,
     *  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 C00058(SSZ(1))
      REAL C00059(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+C00058(I00002)
    1 CONTINUE
      C00059(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('S00042')
      RETURN
      END
      SUBROUTINE S00043(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00036,C00060,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      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
      LOGICAL ECHO1
      REAL C00036(SSZ(5),SSZ(1))
      REAL C00060(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00007=1,SSZ(5)
      RS1=RS1+C00036(I00007,I00002)
    3 CONTINUE
      RS2=C00036(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
      C00060(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('S00043')
      RETURN
      END
      SUBROUTINE S00044(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00011,C00034,C00061,
     *  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 C00011(SSZ(5),SSZ(1))
      REAL C00034(SSZ(5),SSZ(1))
      REAL C00061(SSZ(5),SSZ(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(5)
      RS1=C00011(I00001,I00003)
      RS2=C00034(I00001,I00003)
      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
      C00061(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('S00044')
      RETURN
      END
      SUBROUTINE S00045(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00066,C00067,C00068,C00071,
     *  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 C00066(SSZ(1))
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00071(SSZ(30),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aPHI"',
     *  ' ',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(30)
      RS1=C00067(I00001,I00002)+C00068(I00001,I00002)*
     *  EXP(REAL(C00066(I00002)))
      RS2=1  +EXP(REAL(C00066(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
      C00071(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 "aPHI"',
     *  ' ',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,
     *  C00065,C00066,C00067,C00068,C00069,C00072,
     *  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,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11
      LOGICAL ECHO1
      REAL C00065(SSZ(30),SSZ(1))
      REAL C00066(SSZ(1))
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00072(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aEPSIN"',
     *  ' ',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 I00001=1,SSZ(30)
      RS2=REAL(C00065(I00001,I00002)-C00069(I00001,I00002))
      IF(RS2.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      RS1=RS1+(C00068(I00001,I00002)-C00067(I00001,I00002))*LOG(RS2)
    2 CONTINUE
      RS3=1  +EXP(REAL(C00066(I00002)))
      RS4=2
      IF(RS3.GT.0.0) THEN
        RS5=RS3**RS4
      ELSE IF(RS3.EQ.0.0 .AND. RS4.GT.0.0) THEN
        RS5=0.0
      ELSE IF(RS3.EQ.0.0 .AND. RS4.EQ.0.0) THEN
        RS5=1.0
        IER=11
      ELSE IF(RS3.EQ.0.0 .AND. RS4.LT.0.0) THEN
        RS5=1.0
        IER=12
      ELSE
        IF(RS4.EQ.0.0) THEN
          RS5=1.0
          IER=13
        ELSE IF(INT(RS4).EQ.RS4) THEN
          RS5=RS3**INT(RS4)
        ELSE
          RS5=1.0
          IER=14
        END IF
      END IF
      RS6=RS5
      RS7=EXP(REAL(C00066(I00002)))
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE IF(RS6.EQ.0.0) THEN
        RS8=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS8=1.0
        IER=4
      END IF
      RS9=1
      RS10=RS1-(RS8)
      IF(RS10.NE.0.0) THEN
        RS11=RS9/RS10
      ELSE IF(RS9.EQ.0.0) THEN
        RS11=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS11=1.0
        IER=4
      END IF
      C00072(I00002)=RS11
    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 "aEPSIN"',
     *  ' ',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,
     *  C00064,C00065,C00069,C00071,C00073,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      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 C00064(SSZ(30),SSZ(1))
      REAL C00065(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00071(SSZ(30),SSZ(1))
      REAL C00073(SSZ(30),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aABSHARE"',
     *  ' ',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(30)
      RS1=0.0
      DO 3 I00007=1,SSZ(30)
      RS1=RS1+C00064(I00007,I00002)*C00069(I00007,I00002)
    3 CONTINUE
      RS2=0.0
      DO 4 I00007=1,SSZ(30)
      RS2=RS2+C00065(I00007,I00002)*C00064(I00007,I00002)
    4 CONTINUE
      RS3=C00064(I00001,I00002)*C00069(I00001,I00002)-
     *  C00071(I00001,I00002)*RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE IF(RS3.EQ.0.0) THEN
        RS5=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS5=1.0
        IER=4
      END IF
      C00073(I00001,I00002)=C00071(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 "aABSHARE"',
     *  ' ',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,
     *  C00067,C00068,C00071,C00072,C00074,
     *  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 C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00071(SSZ(30),SSZ(1))
      REAL C00072(SSZ(1))
      REAL C00074(SSZ(30),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aMBSHARE"',
     *  ' ',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(30)
      C00074(I00001,I00002)=C00071(I00001,I00002)-
     *  (C00068(I00001,I00002)-C00067(I00001,I00002))*C00072(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 "aMBSHARE"',
     *  ' ',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,
     *  C00064,C00065,C00069,C00071,C00073,C00075,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      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,RS7,RS8
      LOGICAL ECHO1
      REAL C00064(SSZ(30),SSZ(1))
      REAL C00065(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00071(SSZ(30),SSZ(1))
      REAL C00073(SSZ(30),SSZ(1))
      REAL C00075(SSZ(30),SSZ(30),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aAPE"',
     *  ' ',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 I00007=1,SSZ(30)
      DO 1 I00001=1,SSZ(30)
      RS1=0.0
      DO 4 I00009=1,SSZ(30)
      RS1=RS1+C00064(I00009,I00002)*C00065(I00009,I00002)-
     *  C00064(I00009,I00002)*C00069(I00009,I00002)
    4 CONTINUE
      RS2=0.0
      DO 5 I00009=1,SSZ(30)
      RS2=RS2+C00064(I00009,I00002)*C00065(I00009,I00002)
    5 CONTINUE
      RS3=RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE IF(RS3.EQ.0.0) THEN
        RS5=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS5=1.0
        IER=4
      END IF
      RS6=RS5*C00071(I00001,I00002)*C00071(I00007,I00002)
      RS7=C00073(I00001,I00002)*C00073(I00007,I00002)
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE IF(RS6.EQ.0.0) THEN
        RS8=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS8=1.0
        IER=4
      END IF
      C00075(I00001,I00007,I00002)=RS8
    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 "aAPE"',
     *  ' ',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,
     *  C00073,C00075,C00076,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      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
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00073(SSZ(30),SSZ(1))
      REAL C00075(SSZ(30),SSZ(30),SSZ(1))
      REAL C00076(SSZ(30),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aAPEii"',
     *  ' ',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(30)
      RS1=0.0
      DO 3 I00007=1,SSZ(30)
      LG1=I00007.NE.I00001
      IF(.NOT.LG1) GOTO     3
      RS1=RS1+C00075(I00001,I00007,I00002)*C00073(I00007,I00002)
    3 CONTINUE
      RS2=-RS1
      RS3=C00073(I00001,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
      C00076(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 "aAPEii"',
     *  ' ',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,
     *  C00075,C00076,
     *  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 C00075(SSZ(30),SSZ(30),SSZ(1))
      REAL C00076(SSZ(30),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aAPE"',
     *  ' ',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(30)
      C00075(I00001,I00001,I00002)=C00076(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 "aAPE"',
     *  ' ',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,
     *  C00073,C00074,C00077,
     *  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 C00073(SSZ(30),SSZ(1))
      REAL C00074(SSZ(30),SSZ(1))
      REAL C00077(SSZ(30),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aEY"',
     *  ' ',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(30)
      RS1=C00074(I00001,I00002)
      RS2=C00073(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
      C00077(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 "aEY"',
     *  ' ',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,
     *  C00073,C00075,C00077,C00078,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      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 C00073(SSZ(30),SSZ(1))
      REAL C00075(SSZ(30),SSZ(30),SSZ(1))
      REAL C00077(SSZ(30),SSZ(1))
      REAL C00078(SSZ(30),SSZ(30),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aEP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00007=1,SSZ(30)
      DO 1 I00001=1,SSZ(30)
      C00078(I00001,I00007,I00002)=C00073(I00007,I00002)*
     *  (C00075(I00001,I00007,I00002)-C00077(I00001,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 "aEP"',
     *  ' ',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,
     *  C00066,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)
      LOGICAL ECHO1
      REAL C00066(SSZ(1))
      REAL C00079(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aEXPUCONS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00079(I00002)=EXP(REAL(C00066(I00002)))
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "aEXPUCONS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00054')
      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(216).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GOVEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(216).NE.'n') then
      CALL S00019(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(216),
     *  C00034,C00035,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(218).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(218).NE.'n') then
      CALL S00020(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(218),
     *  C00013,C00015,C00036,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(220).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PRIVEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(220).NE.'n') then
      CALL S00021(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(220),
     *  C00036,C00037,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(222).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(222).NE.'n') then
      CALL S00022(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(222),
     *  C00008,C00035,C00037,C00038,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(224).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DGTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(224).NE.'n') then
      CALL S00023(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(224),
     *  C00009,C00010,C00039,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(226).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IGTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(226).NE.'n') then
      CALL S00024(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(226),
     *  C00011,C00012,C00040,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(228).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TGC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(228).NE.'n') then
      CALL S00025(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(228),
     *  C00039,C00040,C00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(230).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(230).NE.'n') then
      CALL S00026(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(230),
     *  C00013,C00014,C00042,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(232).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IPTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(232).NE.'n') then
      CALL S00027(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(232),
     *  C00015,C00016,C00043,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(234).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TPC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(234).NE.'n') then
      CALL S00028(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(234),
     *  C00042,C00043,C00044,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(236).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DFTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(236).NE.'n') then
      CALL S00029(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(236),
     *  C00019,C00023,C00045,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(238).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IFTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(238).NE.'n') then
      CALL S00030(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(238),
     *  C00020,C00022,C00046,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(240).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TIU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(240).NE.'n') then
      CALL S00031(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(240),
     *  C00045,C00046,C00047,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(242).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'ETAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(242).NE.'n') then
      CALL S00032(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(242),
     *  C00021,C00030,C00048,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(244).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TFU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(244).NE.'n') then
      CALL S00033(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(244),
     *  C00048,C00049,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(246).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(246).NE.'n') then
      CALL S00034(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(246),
     *  C00031,C00033,C00050,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(248).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TOUT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(248).NE.'n') then
      CALL S00035(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(248),
     *  C00050,C00051,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(250).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XTAXD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(250).NE.'n') then
      CALL S00036(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(250),
     *  C00027,C00028,C00052,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(252).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TEX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(252).NE.'n') then
      CALL S00037(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(252),
     *  C00052,C00053,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(254).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'MTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(254).NE.'n') then
      CALL S00038(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(254),
     *  C00025,C00026,C00054,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(256).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TIM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(256).NE.'n') then
      CALL S00039(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(256),
     *  C00054,C00055,
     *  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(260).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'REGINV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(260).NE.'n') then
      CALL S00040(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(260),
     *  C00031,C00057,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(262).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NETINV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(262).NE.'n') then
      CALL S00041(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(262),
     *  C00024,C00031,C00058,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(264).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GLOBINV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(264).NE.'n') then
      CALL S00042(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(264),
     *  C00058,C00059,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(266).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CONSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(266).NE.'n') then
      CALL S00043(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(266),
     *  C00036,C00060,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(277).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GMSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(277).NE.'n') then
      CALL S00044(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(277),
     *  C00011,C00034,C00061,
     *  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(62,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(67,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(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(74,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(76,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(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(82,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(84,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(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(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(230,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(233,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(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
      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(309).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aPHI',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(309).NE.'n') then
      CALL S00045(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(309),
     *  C00066,C00067,C00068,C00071,
     *  ZDZVAL,NDZVAL,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(314).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEPSIN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(314).NE.'n') then
      CALL S00046(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(314),
     *  C00065,C00066,C00067,C00068,C00069,C00072,
     *  ZDZVAL,NDZVAL,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(318).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aABSHARE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(318).NE.'n') then
      CALL S00047(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(318),
     *  C00064,C00065,C00069,C00071,C00073,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(320).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aMBSHARE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(320).NE.'n') then
      CALL S00048(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(320),
     *  C00067,C00068,C00071,C00072,C00074,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(322).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aAPE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(322).NE.'n') then
      CALL S00049(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(322),
     *  C00064,C00065,C00069,C00071,C00073,C00075,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(324).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aAPEii',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(324).NE.'n') then
      CALL S00050(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(324),
     *  C00073,C00075,C00076,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(325).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aAPE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(325).NE.'n') then
      CALL S00051(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(325),
     *  C00075,C00076,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(327).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(327).NE.'n') then
      CALL S00052(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(327),
     *  C00073,C00074,C00077,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(329).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(329).NE.'n') then
      CALL S00053(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(329),
     *  C00073,C00075,C00077,C00078,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(333).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEXPUCONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(333).NE.'n') then
      CALL S00054(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(333),
     *  C00066,C00079,
     *  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('M00003')
      RETURN
      END
      SUBROUTINE S00055(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00036,C00080,C00081,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      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)
      LOGICAL ECHO1
      REAL C00036(SSZ(5),SSZ(1))
      REAL C00080(SSZ(30),SSZ(5))
      REAL C00081(SSZ(30),SSZ(5),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPASG"',
     *  ' ',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(5)
      DO 3 I00009=1,SSZ(30)
      C00081(I00009,I00001,I00002)=C00036(I00001,I00002)*
     *  C00080(I00009,I00001)
    3 CONTINUE
    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 "VPASG"',
     *  ' ',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,
     *  C00036,C00062,C00063,C00082,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      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 LG1
      LOGICAL ECHO1
      REAL C00036(SSZ(5),SSZ(1))
      INTEGER C00062(SSZ(30))
      INTEGER C00063(SSZ(5))
      REAL C00082(SSZ(30),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPAP"',
     *  ' ',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(30)
      RS1=0.0
      DO 3 I00001=1,SSZ(5)
      LG1=C00063(I00001).EQ.C00062(I00005)
      IF(.NOT.LG1) GOTO     3
      RS1=RS1+C00036(I00001,I00002)
    3 CONTINUE
      C00082(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 "VPAP"',
     *  ' ',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,
     *  C00082,C00083,
     *  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)
      LOGICAL ECHO1
      REAL C00082(SSZ(30),SSZ(1))
      REAL C00083(SSZ(30),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPAC"',
     *  ' ',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(30)
      C00083(I00005,I00002)=C00082(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 "VPAC"',
     *  ' ',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,
     *  C00015,C00036,C00085,
     *  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 C00015(SSZ(5),SSZ(1))
      REAL C00036(SSZ(5),SSZ(1))
      REAL C00085(SSZ(5),SSZ(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(5)
      RS1=C00015(I00001,I00003)
      RS2=C00036(I00001,I00003)
      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
      C00085(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('S00058')
      RETURN
      END
      SUBROUTINE S00059(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00030,C00087,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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
      LOGICAL ECHO1
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00087(SSZ(5),SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SPI"',
     *  ' ',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(22)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 4 I00007=1,SSZ(5)
      RS1=RS1+C00030(SSMP(SSMPST(7)-1+I00007),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+I00004))),I00002)
    4 CONTINUE
      RS2=C00030(SSMP(SSMPST(7)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+I00004))),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
      C00087(I00001,SSMP(SSMPST(21)-1+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 "SPI"',
     *  ' ',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,
     *  C00030,C00087,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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
      LOGICAL ECHO1
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00087(SSZ(5),SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SPI"',
     *  ' ',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(21)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 4 I00007=1,SSZ(5)
      RS1=RS1+C00030(SSMP(SSMPST(7)-1+I00007),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004))),I00002)
    4 CONTINUE
      RS2=C00030(SSMP(SSMPST(7)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004))),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
      C00087(I00001,SSMP(SSMPST(20)-1+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 "SPI"',
     *  ' ',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,
     *  C00030,C00088,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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
      LOGICAL ECHO1
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00088(SSZ(5),SSZ(21),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SPIL"',
     *  ' ',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(21)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 4 I00007=1,SSZ(5)
      RS1=RS1+C00030(SSMP(SSMPST(7)-1+I00007),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004))),I00002)
    4 CONTINUE
      RS2=C00030(SSMP(SSMPST(7)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004))),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
      C00088(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 "SPIL"',
     *  ' ',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,
     *  C00030,C00091,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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
      LOGICAL ECHO1
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00091(SSZ(23),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SFS"',
     *  ' ',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(10)
      DO 1 I00001=1,SSZ(23)
      RS1=0.0
      DO 4 I00007=1,SSZ(23)
      RS1=RS1+C00030(SSMP(SSMPST(7)-1+SSMP(SSMPST(22)-1+
     *  I00007)),I00004,I00002)
    4 CONTINUE
      RS2=C00030(SSMP(SSMPST(7)-1+SSMP(SSMPST(22)-1+
     *  I00001)),I00004,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
      C00091(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 "SFS"',
     *  ' ',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,
     *  C00030,C00092,
     *  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 C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00092(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VVA"',
     *  ' ',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(10)
      RS1=0.0
      DO 3 I00001=1,SSZ(9)
      RS1=RS1+C00030(SSMP(SSMPST(6)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00092(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 "VVA"',
     *  ' ',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,
     *  C00030,C00092,C00093,
     *  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,RS4,RS5,RS6,RS7
      LOGICAL ECHO1
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00092(SSZ(10),SSZ(1))
      REAL C00093(SSZ(9))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SVADEFAULT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      RS1=0.0
      DO 1 I00004=1,SSZ(10)
      RS2=0.0
      DO 2 I00002=1,SSZ(1)
      RS2=RS2+C00092(I00004,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    1 CONTINUE
      DO 3 I00001=1,SSZ(9)
      RS3=0.0
      DO 4 I00004=1,SSZ(10)
      RS4=0.0
      DO 5 I00002=1,SSZ(1)
      RS4=RS4+C00030(SSMP(SSMPST(6)-1+I00001),I00004,I00002)
    5 CONTINUE
      RS3=RS3+RS4
    4 CONTINUE
      RS5=RS3
      RS6=RS1
      IF(RS6.NE.0.0) THEN
        RS7=RS5/RS6
      ELSE IF(RS5.EQ.0.0) THEN
        RS7=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS7=1.0
        IER=4
      END IF
      C00093(I00001)=RS7
    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 "SVADEFAULT"',
     *  ' ',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,
     *  C00030,C00092,C00094,
     *  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 C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00092(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SVA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(9)
      DO 2 I00004=1,SSZ(10)
      DO 3 I00002=1,SSZ(1)
      LG1=C00092(I00004,I00002).NE.0
      IF(.NOT.LG1) GOTO     3
      RS1=C00030(SSMP(SSMPST(6)-1+I00001),I00004,I00002)
      RS2=C00092(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
      C00094(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 "SVA"',
     *  ' ',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,
     *  C00092,C00093,C00094,
     *  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 LG1
      LOGICAL ECHO1
      REAL C00092(SSZ(10),SSZ(1))
      REAL C00093(SSZ(9))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SVA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00001=1,SSZ(9)
      DO 2 I00004=1,SSZ(10)
      DO 3 I00002=1,SSZ(1)
      LG1=C00092(I00004,I00002).EQ.0
      IF(.NOT.LG1) GOTO     3
      C00094(I00001,I00004,I00002)=C00093(I00001)
    3 CONTINUE
    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 "SVA"',
     *  ' ',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,
     *  C00020,C00030,C00096,
     *  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 C00020(SSZ(5),SSZ(10),SSZ(1))
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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(10)
      DO 1 I00001=1,SSZ(5)
      RS1=C00020(I00001,I00004,I00003)
      RS2=C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)
      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
      C00096(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('S00067')
      RETURN
      END
      SUBROUTINE S00068(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00030,C00097,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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
      LOGICAL ECHO1
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00097(SSZ(11),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "STC"',
     *  ' ',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(10)
      DO 1 I00001=1,SSZ(11)
      RS1=0.0
      DO 4 I00007=1,SSZ(11)
      RS1=RS1+C00030(I00007,I00004,I00002)
    4 CONTINUE
      RS2=C00030(I00001,I00004,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
      C00097(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 "STC"',
     *  ' ',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,
     *  C00057,C00058,C00098,C00099,
     *  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 C00057(SSZ(1))
      REAL C00058(SSZ(1))
      REAL C00098(SSZ(1))
      REAL C00099(SSZ(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=C00057(I00002)
      RS2=C00098(I00002)+C00058(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(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('S00069')
      RETURN
      END
      SUBROUTINE S00070(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00024,C00031,C00100,
     *  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,RS5
      LOGICAL ECHO1
      REAL C00024(SSZ(1))
      REAL C00031(SSZ(12),SSZ(1))
      REAL C00100(SSZ(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 I00006=1,SSZ(29)
      RS1=RS1+C00031(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(29)-
     *  1+I00006))),I00002)
    2 CONTINUE
      RS2=0.0
      DO 3 I00006=1,SSZ(29)
      RS2=RS2+C00031(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(29)-
     *  1+I00006))),I00002)
    3 CONTINUE
      RS3=RS1
      RS4=RS2-C00024(I00002)
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE IF(RS3.EQ.0.0) THEN
        RS5=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS5=1.0
        IER=4
      END IF
      C00100(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('S00070')
      RETURN
      END
      SUBROUTINE S00071(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00025,C00103,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      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
      LOGICAL ECHO1
      REAL C00025(SSZ(5),SSZ(1),SSZ(1))
      REAL C00103(SSZ(5),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(5)
      RS1=0.0
      DO 4 I00007=1,SSZ(1)
      RS1=RS1+C00025(I00001,I00007,I00003)
    4 CONTINUE
      RS2=C00025(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
      C00103(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('S00071')
      RETURN
      END
      SUBROUTINE S00072(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00105,C00106,
     *  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 C00105(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00106(SSZ(5),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(5)
      RS1=0.0
      DO 4 I00005=1,SSZ(6)
      RS1=RS1+C00105(I00005,I00001,I00002,I00003)
    4 CONTINUE
      C00106(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('S00072')
      RETURN
      END
      SUBROUTINE S00073(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00105,C00107,
     *  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 C00105(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00107(SSZ(6))
      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(6)
      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(5)
      RS3=RS3+C00105(I00005,I00001,I00002,I00003)
    2 CONTINUE
      RS2=RS2+RS3
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00107(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('S00073')
      RETURN
      END
      SUBROUTINE S00074(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00029,C00108,
     *  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 C00029(SSZ(6),SSZ(1))
      REAL C00108(SSZ(6))
      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(6)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00029(I00005,I00002)
    2 CONTINUE
      C00108(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('S00074')
      RETURN
      END
      SUBROUTINE S00075(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00029,C00109,
     *  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 C00029(SSZ(6),SSZ(1))
      REAL C00109(SSZ(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(6)
      RS1=RS1+C00029(I00005,I00002)
    2 CONTINUE
      C00109(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('S00075')
      RETURN
      END
      SUBROUTINE S00076(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00029,C00110,
     *  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 C00029(SSZ(6),SSZ(1))
      REAL C00110(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(6)
      RS2=RS2+C00029(I00005,I00002)
    1 CONTINUE
      RS1=RS1+RS2
    2 CONTINUE
      C00110(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('S00076')
      RETURN
      END
      SUBROUTINE S00077(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00106,C00110,C00111,
     *  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 C00106(SSZ(5),SSZ(1),SSZ(1))
      REAL C00110(1)
      REAL C00111(SSZ(6),SSZ(5),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(5)
      DO 1 I00005=1,SSZ(6)
      RS1=C00106(I00001,I00002,I00003)
      RS2=C00110(1)
      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
      C00111(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('S00077')
      RETURN
      END
      SUBROUTINE S00078(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00105,C00107,C00111,
     *  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 C00105(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00107(SSZ(6))
      REAL C00111(SSZ(6),SSZ(5),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(6)
      LG1=C00107(I00005).NE.0.0
      IF(.NOT.LG1) GOTO     1
      DO 2 I00001=1,SSZ(5)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      RS1=C00105(I00005,I00001,I00002,I00003)
      RS2=C00107(I00005)
      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
      C00111(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('S00078')
      RETURN
      END
      SUBROUTINE S00079(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00109,C00110,C00112,
     *  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 C00109(SSZ(1))
      REAL C00110(1)
      REAL C00112(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 "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(6)
      RS1=C00109(I00002)
      RS2=C00110(1)
      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
      C00112(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('S00079')
      RETURN
      END
      SUBROUTINE S00080(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00029,C00108,C00112,
     *  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 C00029(SSZ(6),SSZ(1))
      REAL C00108(SSZ(6))
      REAL C00112(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 "VTSUPPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 1 I00005=1,SSZ(6)
      LG1=C00108(I00005).NE.0.0
      IF(.NOT.LG1) GOTO     1
      DO 2 I00002=1,SSZ(1)
      RS1=C00029(I00005,I00002)
      RS2=C00108(I00005)
      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
      C00112(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('S00080')
      RETURN
      END
      SUBROUTINE S00081(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00105,C00113,
     *  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 C00105(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00113(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(5)
      RS4=0.0
      DO 1 I00005=1,SSZ(6)
      RS4=RS4+C00105(I00005,I00001,I00002,I00003)
    1 CONTINUE
      RS3=RS3+RS4
    2 CONTINUE
      RS2=RS2+RS3
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00113(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('S00081')
      RETURN
      END
      SUBROUTINE S00082(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00105,C00106,C00114,
     *  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 C00105(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00106(SSZ(5),SSZ(1),SSZ(1))
      REAL C00114(SSZ(6),SSZ(5),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(6)
      DO 2 I00001=1,SSZ(5)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      LG1=C00106(I00001,I00002,I00003).GT.0.0
      IF(.NOT.LG1) GOTO     4
      RS1=C00105(I00005,I00001,I00002,I00003)
      RS2=C00106(I00001,I00002,I00003)
      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
      C00114(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('S00082')
      RETURN
      END
      SUBROUTINE S00083(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00106,C00107,C00113,C00114,
     *  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 C00106(SSZ(5),SSZ(1),SSZ(1))
      REAL C00107(SSZ(6))
      REAL C00113(1)
      REAL C00114(SSZ(6),SSZ(5),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(6)
      DO 2 I00001=1,SSZ(5)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      LG1=C00106(I00001,I00002,I00003).EQ.0.0
      IF(.NOT.LG1) GOTO     4
      RS1=C00107(I00005)
      RS2=C00113(1)
      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
      C00114(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('S00083')
      RETURN
      END
      SUBROUTINE S00084(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00106,C00115,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00106(SSZ(5),SSZ(1),SSZ(1))
      REAL C00115(SSZ(5),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(5)
      C00115(I00001,I00002,I00003)=C00027(I00001,I00002,I00003)+
     *  C00106(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('S00084')
      RETURN
      END
      SUBROUTINE S00085(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00115,C00116,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00115(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(5)
      RS1=C00027(I00001,I00002,I00003)
      RS2=C00115(I00001,I00002,I00003)
      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
      C00116(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('S00085')
      RETURN
      END
      SUBROUTINE S00086(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00106,C00115,C00117,
     *  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 C00106(SSZ(5),SSZ(1),SSZ(1))
      REAL C00115(SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),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(5)
      RS1=C00106(I00001,I00002,I00003)
      RS2=C00115(I00001,I00002,I00003)
      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
      C00117(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('S00086')
      RETURN
      END
      SUBROUTINE S00087(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00050,C00118,
     *  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(12),SSZ(1))
      REAL C00118(SSZ(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(9)
      RS1=RS1+C00050(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001)),I00002)
    2 CONTINUE
      C00118(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('S00087')
      RETURN
      END
      SUBROUTINE S00088(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00119,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00119(SSZ(9),SSZ(10),SSZ(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(10)
      DO 1 I00001=1,SSZ(9)
      RS1=0.0
      DO 4 I00007=1,SSZ(10)
      RS1=RS1+C00021(I00001,I00007,I00002)
    4 CONTINUE
      RS2=C00021(I00001,I00004,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
      C00119(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('S00088')
      RETURN
      END
      SUBROUTINE S00089(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00024,C00033,C00121,
     *  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 C00024(SSZ(1))
      REAL C00033(SSZ(12),SSZ(1))
      REAL C00121(SSZ(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(9)
      RS1=RS1+C00033(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001)),I00002)
    2 CONTINUE
      C00121(I00002)=RS1-C00024(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('S00089')
      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.
      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(345).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPASG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(345).NE.'n') then
      CALL S00055(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(345),
     *  C00036,C00080,C00081,
     *  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(349).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPAP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(349).NE.'n') then
      CALL S00056(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(349),
     *  C00036,C00062,C00063,C00082,
     *  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(353).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPAC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(353).NE.'n') then
      CALL S00057(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(353),
     *  C00082,C00083,
     *  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
      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(378).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PMSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(378).NE.'n') then
      CALL S00058(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(378),
     *  C00015,C00036,C00085,
     *  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(414).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SPI',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(414).NE.'n') then
      CALL S00059(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(414),
     *  C00030,C00087,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(415).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SPI',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(415).NE.'n') then
      CALL S00060(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(415),
     *  C00030,C00087,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(417).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SPIL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(417).NE.'n') then
      CALL S00061(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(417),
     *  C00030,C00088,
     *  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(433).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SFS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(433).NE.'n') then
      CALL S00062(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(433),
     *  C00030,C00091,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(449).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VVA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(449).NE.'n') then
      CALL S00063(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(449),
     *  C00030,C00092,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(451).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SVADEFAULT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(451).NE.'n') then
      CALL S00064(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(451),
     *  C00030,C00092,C00093,
     *  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''',
     *    'SVA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(453).NE.'n') then
      CALL S00065(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(453),
     *  C00030,C00092,C00094,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(454).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SVA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(454).NE.'n') then
      CALL S00066(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(454),
     *  C00092,C00093,C00094,
     *  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(466).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FMSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(466).NE.'n') then
      CALL S00067(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(466),
     *  C00020,C00030,C00096,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(476).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'STC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(476).NE.'n') then
      CALL S00068(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(476),
     *  C00030,C00097,
     *  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(493).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INVKERATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(493).NE.'n') then
      CALL S00069(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(493),
     *  C00057,C00058,C00098,C00099,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(496).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GRNETRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(496).NE.'n') then
      CALL S00070(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(496),
     *  C00024,C00031,C00100,
     *  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(520).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'MSHRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(520).NE.'n') then
      CALL S00071(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(520),
     *  C00025,C00103,
     *  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(542).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(542).NE.'n') then
      CALL S00072(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(542),
     *  C00105,C00106,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(544).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(544).NE.'n') then
      CALL S00073(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(544),
     *  C00105,C00107,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(546).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMPROV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(546).NE.'n') then
      CALL S00074(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(546),
     *  C00029,C00108,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(548).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTRPROV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(548).NE.'n') then
      CALL S00075(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(548),
     *  C00029,C00109,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(550).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(550).NE.'n') then
      CALL S00076(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(550),
     *  C00029,C00110,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(553).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSESHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(553).NE.'n') then
      CALL S00077(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(553),
     *  C00106,C00110,C00111,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(554).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSESHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(554).NE.'n') then
      CALL S00078(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(554),
     *  C00105,C00107,C00111,
     *  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''',
     *    'VTSUPPSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(557).NE.'n') then
      CALL S00079(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(557),
     *  C00109,C00110,C00112,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(558).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTSUPPSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(558).NE.'n') then
      CALL S00080(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(558),
     *  C00029,C00108,C00112,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(561).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTUSE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(561).NE.'n') then
      CALL S00081(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(561),
     *  C00105,C00113,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(563).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD_MSH',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(563).NE.'n') then
      CALL S00082(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(563),
     *  C00105,C00106,C00114,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(564).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD_MSH',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(564).NE.'n') then
      CALL S00083(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(564),
     *  C00106,C00107,C00113,C00114,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(569).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWSCOST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(569).NE.'n') then
      CALL S00084(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(569),
     *  C00027,C00106,C00115,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(571).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FOBSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(571).NE.'n') then
      CALL S00085(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(571),
     *  C00027,C00115,C00116,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(573).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TRNSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(573).NE.'n') then
      CALL S00086(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(573),
     *  C00106,C00115,C00117,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(579).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TINC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(579).NE.'n') then
      CALL S00087(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(579),
     *  C00050,C00118,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(582).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'REVSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(582).NE.'n') then
      CALL S00088(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(582),
     *  C00021,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
      IF(ECHO1.AND.DOIG(588).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(588).NE.'n') then
      CALL S00089(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(588),
     *  C00024,C00033,C00121,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00004')
      RETURN
      END
      SUBROUTINE S00090(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00041,C00044,C00047,C00049,C00051,C00053,C00055,C00122,
     *  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 C00041(SSZ(1))
      REAL C00044(SSZ(1))
      REAL C00047(SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00051(SSZ(1))
      REAL C00053(SSZ(1))
      REAL C00055(SSZ(1))
      REAL C00122(SSZ(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)
      C00122(I00002)=C00044(I00002)+C00041(I00002)+C00047(I00002)+
     *  C00049(I00002)+C00051(I00002)+C00053(I00002)+C00055(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('S00090')
      RETURN
      END
      SUBROUTINE S00091(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00023,C00032,C00123,
     *  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 C00023(SSZ(5),SSZ(10),SSZ(1))
      REAL C00032(SSZ(5),SSZ(1))
      REAL C00123(SSZ(5),SSZ(10),SSZ(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(10)
      DO 1 I00001=1,SSZ(5)
      RS1=C00023(I00001,I00004,I00002)
      RS2=C00032(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
      C00123(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('S00091')
      RETURN
      END
      SUBROUTINE S00092(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00014,C00032,C00124,
     *  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 C00014(SSZ(5),SSZ(1))
      REAL C00032(SSZ(5),SSZ(1))
      REAL C00124(SSZ(5),SSZ(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(5)
      RS1=C00014(I00001,I00002)
      RS2=C00032(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
      C00124(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('S00092')
      RETURN
      END
      SUBROUTINE S00093(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00010,C00032,C00125,
     *  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(5),SSZ(1))
      REAL C00032(SSZ(5),SSZ(1))
      REAL C00125(SSZ(5),SSZ(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(5)
      RS1=C00010(I00001,I00002)
      RS2=C00032(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
      C00125(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('S00093')
      RETURN
      END
      SUBROUTINE S00094(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00032,C00033,C00126,
     *  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 C00032(SSZ(5),SSZ(1))
      REAL C00033(SSZ(12),SSZ(1))
      REAL C00126(SSZ(5),SSZ(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(5)
      RS1=C00032(I00001,I00002)
      RS2=C00033(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+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
      C00126(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('S00094')
      RETURN
      END
      SUBROUTINE S00095(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00029,C00033,C00127,
     *  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 C00029(SSZ(6),SSZ(1))
      REAL C00033(SSZ(12),SSZ(1))
      REAL C00127(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 "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(6)
      RS1=C00029(I00005,I00002)
      RS2=C00033(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005))),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
      C00127(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('S00095')
      RETURN
      END
      SUBROUTINE S00096(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00028,C00033,C00128,
     *  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 C00028(SSZ(5),SSZ(1),SSZ(1))
      REAL C00033(SSZ(12),SSZ(1))
      REAL C00128(SSZ(5),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(5)
      RS1=C00028(I00001,I00002,I00003)
      RS2=C00033(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+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
      C00128(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('S00096')
      RETURN
      END
      SUBROUTINE S00097(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00012,C00016,C00022,C00129,
     *  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(5),SSZ(1))
      REAL C00016(SSZ(5),SSZ(1))
      REAL C00022(SSZ(5),SSZ(10),SSZ(1))
      REAL C00129(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1+C00022(I00001,I00004,I00002)
    3 CONTINUE
      C00129(I00001,I00002)=RS1+C00016(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 "VIM"',
     *  ' ',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,
     *  C00022,C00129,C00130,
     *  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 C00022(SSZ(5),SSZ(10),SSZ(1))
      REAL C00129(SSZ(5),SSZ(1))
      REAL C00130(SSZ(5),SSZ(10),SSZ(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(10)
      DO 1 I00001=1,SSZ(5)
      RS1=C00022(I00001,I00004,I00002)
      RS2=C00129(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
      C00130(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('S00098')
      RETURN
      END
      SUBROUTINE S00099(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00016,C00129,C00131,
     *  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(5),SSZ(1))
      REAL C00129(SSZ(5),SSZ(1))
      REAL C00131(SSZ(5),SSZ(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(5)
      RS1=C00016(I00001,I00002)
      RS2=C00129(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
      C00131(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('S00099')
      RETURN
      END
      SUBROUTINE S00100(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00012,C00129,C00132,
     *  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(5),SSZ(1))
      REAL C00129(SSZ(5),SSZ(1))
      REAL C00132(SSZ(5),SSZ(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(5)
      RS1=C00012(I00001,I00002)
      RS2=C00129(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
      C00132(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('S00100')
      RETURN
      END
      SUBROUTINE S00101(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00133,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00133(SSZ(28),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOMAGR"',
     *  ' ',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(28)
      RS1=0.0
      DO 3 I00007=1,SSZ(15)
      RS1=RS1+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00007)),I00002)
    3 CONTINUE
      C00133(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 "VOMAGR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00101')
      RETURN
      END
      SUBROUTINE S00102(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00134,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00134(SSZ(28),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOMNAGR"',
     *  ' ',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(28)
      RS1=0.0
      DO 3 I00007=1,SSZ(16)
      RS1=RS1+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00007),I00002)
    3 CONTINUE
      C00134(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 "VOMNAGR"',
     *  ' ',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,
     *  C00027,C00029,C00136,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00136(SSZ(5),SSZ(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(6)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00136(SSMP(SSMPST(2)-1+I00005),I00002)=RS1+C00029(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('S00103')
      RETURN
      END
      SUBROUTINE S00104(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00136,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00136(SSZ(5),SSZ(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(7)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00136(SSMP(SSMPST(3)-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('S00104')
      RETURN
      END
      SUBROUTINE S00105(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00136,C00137,
     *  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 C00136(SSZ(5),SSZ(1))
      REAL C00137(SSZ(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(5)
      RS1=RS1+C00136(I00001,I00002)
    2 CONTINUE
      C00137(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('S00105')
      RETURN
      END
      SUBROUTINE S00106(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00026,C00138,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00138(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS1=RS1+C00026(I00001,I00002,I00003)
    3 CONTINUE
      C00138(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('S00106')
      RETURN
      END
      SUBROUTINE S00107(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00138,C00139,
     *  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 C00138(SSZ(5),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 "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(5)
      RS1=RS1+C00138(I00001,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 "VIWREGION"',
     *  ' ',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,
     *  C00033,C00140,
     *  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 C00033(SSZ(12),SSZ(1))
      REAL C00140(SSZ(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(9)
      RS1=RS1+C00033(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001)),I00002)
    2 CONTINUE
      C00140(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('S00108')
      RETURN
      END
      SUBROUTINE S00109(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00140,C00141,
     *  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 C00140(SSZ(1))
      REAL C00141(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+C00140(I00002)
    1 CONTINUE
      C00141(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('S00109')
      RETURN
      END
      SUBROUTINE S00110(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00026,C00027,C00029,C00031,C00034,C00036,C00142,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      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)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8
      LOGICAL ECHO1
      REAL C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00031(SSZ(12),SSZ(1))
      REAL C00034(SSZ(5),SSZ(1))
      REAL C00036(SSZ(5),SSZ(1))
      REAL C00142(SSZ(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(5)
      RS1=RS1+C00036(I00001,I00003)
    2 CONTINUE
      RS2=0.0
      DO 3 I00001=1,SSZ(5)
      RS2=RS2+C00034(I00001,I00003)
    3 CONTINUE
      RS3=0.0
      DO 4 I00007=1,SSZ(8)
      RS3=RS3+C00031(SSMP(SSMPST(10)-1+SSMP(SSMPST(5)-1+I00007)),I00003)
    4 CONTINUE
      RS4=0.0
      DO 6 I00002=1,SSZ(1)
      RS5=0.0
      DO 5 I00001=1,SSZ(5)
      RS5=RS5+C00027(I00001,I00003,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    6 CONTINUE
      RS6=0.0
      DO 7 I00005=1,SSZ(6)
      RS6=RS6+C00029(I00005,I00003)
    7 CONTINUE
      RS7=0.0
      DO 9 I00002=1,SSZ(1)
      RS8=0.0
      DO 8 I00001=1,SSZ(5)
      RS8=RS8+C00026(I00001,I00002,I00003)
    8 CONTINUE
      RS7=RS7+RS8
    9 CONTINUE
      C00142(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('S00110')
      RETURN
      END
      SUBROUTINE S00111(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00136,C00143,
     *  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 C00136(SSZ(5),SSZ(1))
      REAL C00143(SSZ(5))
      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(5)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00136(I00001,I00002)
    2 CONTINUE
      C00143(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('S00111')
      RETURN
      END
      SUBROUTINE S00112(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00137,C00144,
     *  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 C00137(SSZ(1))
      REAL C00144(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+C00137(I00002)
    1 CONTINUE
      C00144(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('S00112')
      RETURN
      END
      SUBROUTINE S00113(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00138,C00145,
     *  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 C00138(SSZ(5),SSZ(1))
      REAL C00145(SSZ(5))
      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(5)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00138(I00001,I00002)
    2 CONTINUE
      C00145(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('S00113')
      RETURN
      END
      SUBROUTINE S00114(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00028,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,RS4,RS5
      LOGICAL ECHO1
      REAL C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00028(SSZ(5),SSZ(1),SSZ(1))
      REAL C00146(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00027(I00001,I00002,I00003)
    3 CONTINUE
      RS2=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=RS2+C00028(I00001,I00002,I00003)
    4 CONTINUE
      RS3=RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE IF(RS3.EQ.0.0) THEN
        RS5=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS5=1.0
        IER=4
      END IF
      C00146(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('S00114')
      RETURN
      END
      SUBROUTINE S00115(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00029,C00032,C00146,C00147,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00032(SSZ(5),SSZ(1))
      REAL C00146(SSZ(5),SSZ(1))
      REAL C00147(SSZ(5),SSZ(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(6)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00147(SSMP(SSMPST(2)-1+I00005),I00002)=C00032(SSMP(SSMPST(2)-1+
     *  I00005),I00002)*C00146(SSMP(SSMPST(2)-1+I00005),I00002)+RS1+
     *  C00029(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('S00115')
      RETURN
      END
      SUBROUTINE S00116(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00032,C00146,C00147,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00032(SSZ(5),SSZ(1))
      REAL C00146(SSZ(5),SSZ(1))
      REAL C00147(SSZ(5),SSZ(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(7)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00147(SSMP(SSMPST(3)-1+I00001),I00002)=C00032(SSMP(SSMPST(3)-1+
     *  I00001),I00002)*C00146(SSMP(SSMPST(3)-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('S00116')
      RETURN
      END
      SUBROUTINE S00117(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00147,C00148,
     *  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 C00147(SSZ(5),SSZ(1))
      REAL C00148(SSZ(5))
      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(5)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)
      RS1=RS1+C00147(I00001,I00002)
    2 CONTINUE
      C00148(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('S00117')
      RETURN
      END
      SUBROUTINE S00118(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00030,C00034,C00036,C00149,
     *  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 C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00034(SSZ(5),SSZ(1))
      REAL C00036(SSZ(5),SSZ(1))
      REAL C00149(SSZ(5))
      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(5)
      RS1=0.0
      DO 2 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00004=1,SSZ(10)
      RS2=RS2+C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)
    3 CONTINUE
      RS1=RS1+C00036(I00001,I00003)+C00034(I00001,I00003)+RS2
    2 CONTINUE
      C00149(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('S00118')
      RETURN
      END
      SUBROUTINE S00119(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00137,C00139,C00150,
     *  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 C00137(SSZ(1))
      REAL C00139(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 "TBAL"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00150(I00002)=C00137(I00002)-C00139(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('S00119')
      RETURN
      END
      SUBROUTINE S00120(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00029,C00151,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00007
      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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00151(SSZ(5),SSZ(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(6)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
    3 CONTINUE
      RS2=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=0.0
      DO 4 I00007=1,SSZ(5)
      RS3=RS3+C00027(I00007,I00002,I00003)
    4 CONTINUE
      RS2=RS2+RS3
    5 CONTINUE
      RS4=0.0
      DO 6 I00010=1,SSZ(6)
      RS4=RS4+C00029(I00010,I00002)
    6 CONTINUE
      RS5=RS1+C00029(I00005,I00002)
      RS6=RS2+RS4
      IF(RS6.NE.0.0) THEN
        RS7=RS5/RS6
      ELSE IF(RS5.EQ.0.0) THEN
        RS7=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS7=1.0
        IER=4
      END IF
      C00151(SSMP(SSMPST(2)-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('S00120')
      RETURN
      END
      SUBROUTINE S00121(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00029,C00151,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00007
      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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00151(SSZ(5),SSZ(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(7)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
    3 CONTINUE
      RS2=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=0.0
      DO 4 I00007=1,SSZ(5)
      RS3=RS3+C00027(I00007,I00002,I00003)
    4 CONTINUE
      RS2=RS2+RS3
    5 CONTINUE
      RS4=0.0
      DO 6 I00010=1,SSZ(6)
      RS4=RS4+C00029(I00010,I00002)
    6 CONTINUE
      RS5=RS1
      RS6=RS2+RS4
      IF(RS6.NE.0.0) THEN
        RS7=RS5/RS6
      ELSE IF(RS5.EQ.0.0) THEN
        RS7=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS7=1.0
        IER=4
      END IF
      C00151(SSMP(SSMPST(3)-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('S00121')
      RETURN
      END
      SUBROUTINE S00122(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00105,C00152,
     *  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 C00105(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00152(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 "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(6)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(5)
      RS2=RS2+C00105(I00005,I00001,I00002,I00003)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00152(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('S00122')
      RETURN
      END
      SUBROUTINE S00123(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00152,C00153,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00152(SSZ(6),SSZ(1))
      REAL C00153(SSZ(5),SSZ(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(6)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00153(SSMP(SSMPST(2)-1+I00005),I00003)=RS1+C00152(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('S00123')
      RETURN
      END
      SUBROUTINE S00124(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00153,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00153(SSZ(5),SSZ(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(7)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00153(SSMP(SSMPST(3)-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('S00124')
      RETURN
      END
      SUBROUTINE S00125(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00153,C00154,
     *  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 C00153(SSZ(5),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 "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(5)
      RS1=RS1+C00153(I00001,I00003)
    2 CONTINUE
      C00154(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('S00125')
      RETURN
      END
      SUBROUTINE S00126(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00153,C00154,C00155,
     *  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 C00153(SSZ(5),SSZ(1))
      REAL C00154(SSZ(1))
      REAL C00155(SSZ(5),SSZ(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(5)
      RS1=C00153(I00001,I00003)
      RS2=C00154(I00003)
      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
      C00155(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('S00126')
      RETURN
      END
      SUBROUTINE S00127(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00029,C00156,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      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
      LOGICAL ECHO1
      REAL C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00156(SSZ(5),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(6)
      DO 2 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00007=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00007)
    3 CONTINUE
      DO 4 I00003=1,SSZ(1)
      RS2=C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
      RS3=RS1+C00029(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
      C00156(SSMP(SSMPST(2)-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('S00127')
      RETURN
      END
      SUBROUTINE S00128(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00156,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      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
      LOGICAL ECHO1
      REAL C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00156(SSZ(5),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(7)
      DO 2 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00007=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(3)-1+I00001),I00002,I00007)
    3 CONTINUE
      DO 4 I00003=1,SSZ(1)
      RS2=C00027(SSMP(SSMPST(3)-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
      C00156(SSMP(SSMPST(3)-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('S00128')
      RETURN
      END
      SUBROUTINE S00129(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00029,C00157,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      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
      LOGICAL ECHO1
      REAL C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00157(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 "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(6)
      RS1=0.0
      DO 3 I00007=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00007)
    3 CONTINUE
      RS2=C00029(I00005,I00002)
      RS3=RS1+C00029(I00005,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      C00157(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('S00129')
      RETURN
      END
      SUBROUTINE S00130(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00153,C00158,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00153(SSZ(5),SSZ(1))
      REAL C00158(SSZ(5),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(5)
      RS1=C00027(I00001,I00002,I00003)
      RS2=C00153(I00001,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00158(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('S00130')
      RETURN
      END
      SUBROUTINE S00131(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00152,C00153,C00159,
     *  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 C00152(SSZ(6),SSZ(1))
      REAL C00153(SSZ(5),SSZ(1))
      REAL C00159(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 "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(6)
      RS1=C00152(I00005,I00003)
      RS2=C00153(SSMP(SSMPST(2)-1+I00005),I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00159(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('S00131')
      RETURN
      END
      SUBROUTINE S00132(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00029,C00160,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      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,RS6
      LOGICAL ECHO1
      REAL C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00160(SSZ(5),SSZ(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(6)
      RS1=0.0
      DO 2 I00007=1,SSZ(1)
      RS2=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=RS2+C00027(SSMP(SSMPST(2)-1+I00005),I00007,I00003)
    3 CONTINUE
      RS1=RS1+RS2+C00029(I00005,I00007)
    2 CONTINUE
      DO 4 I00002=1,SSZ(1)
      RS3=0.0
      DO 5 I00003=1,SSZ(1)
      RS3=RS3+C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
    5 CONTINUE
      RS4=RS3+C00029(I00005,I00002)
      RS5=RS1
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IER=2
      END IF
      C00160(SSMP(SSMPST(2)-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('S00132')
      RETURN
      END
      SUBROUTINE S00133(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00160,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      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,RS6
      LOGICAL ECHO1
      REAL C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00160(SSZ(5),SSZ(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(7)
      RS1=0.0
      DO 2 I00007=1,SSZ(1)
      RS2=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=RS2+C00027(SSMP(SSMPST(3)-1+I00001),I00007,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+C00027(SSMP(SSMPST(3)-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
      C00160(SSMP(SSMPST(3)-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('S00133')
      RETURN
      END
      SUBROUTINE S00134(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00029,C00161,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00007
      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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00161(SSZ(5))
      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 I00007=1,SSZ(5)
      RS2=0.0
      DO 2 I00002=1,SSZ(1)
      RS3=0.0
      DO 3 I00003=1,SSZ(1)
      RS3=RS3+C00027(I00007,I00002,I00003)
    3 CONTINUE
      RS2=RS2+RS3
    2 CONTINUE
      RS1=RS1+RS2
    1 CONTINUE
      RS4=0.0
      DO 4 I00010=1,SSZ(6)
      RS5=0.0
      DO 5 I00002=1,SSZ(1)
      RS5=RS5+C00029(I00010,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    4 CONTINUE
      DO 6 I00005=1,SSZ(6)
      RS6=0.0
      DO 7 I00002=1,SSZ(1)
      RS7=0.0
      DO 8 I00003=1,SSZ(1)
      RS7=RS7+C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
    8 CONTINUE
      RS6=RS6+RS7+C00029(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
      C00161(SSMP(SSMPST(2)-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('S00134')
      RETURN
      END
      SUBROUTINE S00135(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00029,C00161,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00007
      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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00161(SSZ(5))
      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 I00007=1,SSZ(5)
      RS2=0.0
      DO 2 I00002=1,SSZ(1)
      RS3=0.0
      DO 3 I00003=1,SSZ(1)
      RS3=RS3+C00027(I00007,I00002,I00003)
    3 CONTINUE
      RS2=RS2+RS3
    2 CONTINUE
      RS1=RS1+RS2
    1 CONTINUE
      RS4=0.0
      DO 4 I00010=1,SSZ(6)
      RS5=0.0
      DO 5 I00002=1,SSZ(1)
      RS5=RS5+C00029(I00010,I00002)
    5 CONTINUE
      RS4=RS4+RS5
    4 CONTINUE
      DO 6 I00001=1,SSZ(7)
      RS6=0.0
      DO 7 I00002=1,SSZ(1)
      RS7=0.0
      DO 8 I00003=1,SSZ(1)
      RS7=RS7+C00027(SSMP(SSMPST(3)-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
      C00161(SSMP(SSMPST(3)-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('S00135')
      RETURN
      END
      SUBROUTINE S00136(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00033,C00162,
     *  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,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00033(SSZ(12),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 "FCAPSHR"',
     *  ' ',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 I00001=1,SSZ(14)
      RS1=RS1+C00033(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(11)-
     *  1+I00001))),I00002)
    2 CONTINUE
      RS2=0.0
      DO 3 I00004=1,SSZ(15)
      RS3=0.0
      DO 4 I00001=1,SSZ(14)
      RS3=RS3+C00021(SSMP(SSMPST(11)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
    4 CONTINUE
      RS4=RS3
      RS5=RS1
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IER=2
      END IF
      RS2=RS2+RS6
    3 CONTINUE
      C00162(I00002)=RS2
    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 "FCAPSHR"',
     *  ' ',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,
     *  C00024,C00162,C00163,
     *  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 C00024(SSZ(1))
      REAL C00162(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 "FVDEP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00163(I00002)=C00162(I00002)*C00024(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FVDEP"',
     *  ' ',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,
     *  C00021,C00164,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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,RS6
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00164(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 "GAMMA"',
     *  ' ',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(9)
      RS1=0.0
      DO 3 I00004=1,SSZ(16)
      RS1=RS1+C00021(I00001,SSMP(SSMPST(13)-1+I00004),I00002)
    3 CONTINUE
      RS2=0.0
      DO 5 I00004=1,SSZ(16)
      RS3=0.0
      DO 4 I00007=1,SSZ(9)
      RS3=RS3+C00021(I00007,SSMP(SSMPST(13)-1+I00004),I00002)
    4 CONTINUE
      RS2=RS2+RS3
    5 CONTINUE
      RS4=RS1
      RS5=RS2
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IER=2
      END IF
      C00164(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 "GAMMA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00138')
      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(ECHO1.AND.DOIG(597).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INDTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(597).NE.'n') then
      CALL S00090(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(597),
     *  C00041,C00044,C00047,C00049,C00051,C00053,C00055,C00122,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(614).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(614).NE.'n') then
      CALL S00091(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(614),
     *  C00023,C00032,C00123,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(616).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(616).NE.'n') then
      CALL S00092(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(616),
     *  C00014,C00032,C00124,
     *  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''',
     *    'SHRDGM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(618).NE.'n') then
      CALL S00093(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(618),
     *  C00010,C00032,C00125,
     *  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''',
     *    'SHRDM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(622).NE.'n') then
      CALL S00094(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(622),
     *  C00032,C00033,C00126,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(624).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(624).NE.'n') then
      CALL S00095(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(624),
     *  C00029,C00033,C00127,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(626).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRXMD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(626).NE.'n') then
      CALL S00096(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(626),
     *  C00028,C00033,C00128,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(631).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(631).NE.'n') then
      CALL S00097(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(631),
     *  C00012,C00016,C00022,C00129,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(633).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(633).NE.'n') then
      CALL S00098(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(633),
     *  C00022,C00129,C00130,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(635).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(635).NE.'n') then
      CALL S00099(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(635),
     *  C00016,C00129,C00131,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(637).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIGM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(637).NE.'n') then
      CALL S00100(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(637),
     *  C00012,C00129,C00132,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(640).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOMAGR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(640).NE.'n') then
      CALL S00101(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(640),
     *  C00021,C00133,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(645).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOMNAGR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(645).NE.'n') then
      CALL S00102(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(645),
     *  C00021,C00134,
     *  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(666).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(666).NE.'n') then
      CALL S00103(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(666),
     *  C00027,C00029,C00136,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(667).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(667).NE.'n') then
      CALL S00104(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(667),
     *  C00027,C00136,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(669).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWREGION',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(669).NE.'n') then
      CALL S00105(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(669),
     *  C00136,C00137,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(671).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(671).NE.'n') then
      CALL S00106(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(671),
     *  C00026,C00138,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(673).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWREGION',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(673).NE.'n') then
      CALL S00107(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(673),
     *  C00138,C00139,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(677).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VENDWREG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(677).NE.'n') then
      CALL S00108(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(677),
     *  C00033,C00140,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(681).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VENDWWLD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(681).NE.'n') then
      CALL S00109(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(681),
     *  C00140,C00141,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(691).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GDP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(691).NE.'n') then
      CALL S00110(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(691),
     *  C00026,C00027,C00029,C00031,C00034,C00036,C00142,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(702).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWCOMMOD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(702).NE.'n') then
      CALL S00111(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(702),
     *  C00136,C00143,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(704).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWLD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(704).NE.'n') then
      CALL S00112(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(704),
     *  C00137,C00144,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(706).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWCOMMOD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(706).NE.'n') then
      CALL S00113(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(706),
     *  C00138,C00145,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(708).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PW_PM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(708).NE.'n') then
      CALL S00114(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(708),
     *  C00027,C00028,C00146,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(710).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(710).NE.'n') then
      CALL S00115(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(710),
     *  C00027,C00029,C00032,C00146,C00147,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(711).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(711).NE.'n') then
      CALL S00116(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(711),
     *  C00027,C00032,C00146,C00147,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(713).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VWOW',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(713).NE.'n') then
      CALL S00117(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(713),
     *  C00147,C00148,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(715).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VWOU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(715).NE.'n') then
      CALL S00118(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(715),
     *  C00030,C00034,C00036,C00149,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(773).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TBAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(773).NE.'n') then
      CALL S00119(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(773),
     *  C00137,C00139,C00150,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(777).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(777).NE.'n') then
      CALL S00120(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(777),
     *  C00027,C00029,C00151,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(778).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(778).NE.'n') then
      CALL S00121(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(778),
     *  C00027,C00029,C00151,
     *  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''',
     *    'VTICOMM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(780).NE.'n') then
      CALL S00122(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(780),
     *  C00105,C00152,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(782).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDIRALL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(782).NE.'n') then
      CALL S00123(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(782),
     *  C00027,C00152,C00153,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(783).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDIRALL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(783).NE.'n') then
      CALL S00124(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(783),
     *  C00027,C00153,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(785).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDATOT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(785).NE.'n') then
      CALL S00125(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(785),
     *  C00153,C00154,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(787).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SM_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(787).NE.'n') then
      CALL S00126(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(787),
     *  C00153,C00154,C00155,
     *  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(790).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(790).NE.'n') then
      CALL S00127(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(790),
     *  C00027,C00029,C00156,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(791).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(791).NE.'n') then
      CALL S00128(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(791),
     *  C00027,C00156,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(794).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SXT_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(794).NE.'n') then
      CALL S00129(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(794),
     *  C00027,C00029,C00157,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(799).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SM_IRS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(799).NE.'n') then
      CALL S00130(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(799),
     *  C00027,C00153,C00158,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(801).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SMT_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(801).NE.'n') then
      CALL S00131(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(801),
     *  C00152,C00153,C00159,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(806).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(806).NE.'n') then
      CALL S00132(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(806),
     *  C00027,C00029,C00160,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(807).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_IR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(807).NE.'n') then
      CALL S00133(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(807),
     *  C00027,C00160,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(811).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_I',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(811).NE.'n') then
      CALL S00134(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(811),
     *  C00027,C00029,C00161,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(812).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_I',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(812).NE.'n') then
      CALL S00135(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(812),
     *  C00027,C00029,C00161,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(830).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FCAPSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(830).NE.'n') then
      CALL S00136(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(830),
     *  C00021,C00033,C00162,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(832).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FVDEP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(832).NE.'n') then
      CALL S00137(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(832),
     *  C00024,C00162,C00163,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(834).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GAMMA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(834).NE.'n') then
      CALL S00138(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(834),
     *  C00021,C00164,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00005')
      RETURN
      END
      SUBROUTINE S00139(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00166,
     *  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 C00021(SSZ(9),SSZ(10),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 "FVA"',
     *  ' ',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(15)
      RS2=0.0
      DO 2 I00001=1,SSZ(9)
      RS2=RS2+C00021(I00001,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00166(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 "FVA"',
     *  ' ',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,
     *  C00165,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 C00165(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 "NFVA"',
     *  ' ',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=1  -C00165(I00002)
      RS2=C00165(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00167(I00002)=(RS3)*C00166(I00002)
    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 "NFVA"',
     *  ' ',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,
     *  C00164,C00167,C00168,
     *  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 C00164(SSZ(9),SSZ(1))
      REAL C00167(SSZ(1))
      REAL C00168(SSZ(28),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "NFVOA"',
     *  ' ',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(28)
      C00168(I00001,I00002)=C00164(SSMP(SSMPST(27)-1+I00001),I00002)*
     *  C00167(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 "NFVOA"',
     *  ' ',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,
     *  C00168,C00169,
     *  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 C00168(SSZ(28),SSZ(1))
      REAL C00169(SSZ(28),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "NFVOM"',
     *  ' ',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(28)
      C00169(I00001,I00002)=C00168(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 "NFVOM"',
     *  ' ',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,
     *  C00033,C00169,C00170,
     *  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,RS4,RS5
      LOGICAL ECHO1
      REAL C00033(SSZ(12),SSZ(1))
      REAL C00169(SSZ(28),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 formula for coefficient "NFCAPSHR"',
     *  ' ',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 I00001=1,SSZ(14)
      RS1=RS1+C00169(SSMP(SSMPST(30)-1+I00001),I00002)
    2 CONTINUE
      RS2=0.0
      DO 3 I00004=1,SSZ(14)
      RS2=RS2+C00033(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(11)-
     *  1+I00004))),I00002)
    3 CONTINUE
      RS3=RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE
        RS5=1.0
        IER=2
      END IF
      C00170(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 "NFCAPSHR"',
     *  ' ',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,
     *  C00024,C00170,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 C00024(SSZ(1))
      REAL C00170(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 formula for coefficient "NFVDEP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00171(I00002)=C00170(I00002)*C00024(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "NFVDEP"',
     *  ' ',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,
     *  C00021,C00163,C00169,C00171,C00172,
     *  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,RS3
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00163(SSZ(1))
      REAL C00169(SSZ(28),SSZ(1))
      REAL C00171(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 formula for coefficient "FFY"',
     *  ' ',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(15)
      RS2=0.0
      DO 2 I00001=1,SSZ(9)
      RS2=RS2+C00021(I00001,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      RS3=0.0
      DO 4 I00001=1,SSZ(28)
      RS3=RS3+C00169(I00001,I00002)
    4 CONTINUE
      C00172(I00002)=RS1-C00163(I00002)+RS3-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 "FFY"',
     *  ' ',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,
     *  C00021,C00163,C00173,
     *  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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00163(SSZ(1))
      REAL C00173(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FFYON"',
     *  ' ',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(15)
      RS2=0.0
      DO 2 I00001=1,SSZ(9)
      RS2=RS2+C00021(I00001,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00173(I00002)=RS1-C00163(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FFYON"',
     *  ' ',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,
     *  C00169,C00171,C00174,
     *  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 C00169(SSZ(28),SSZ(1))
      REAL C00171(SSZ(1))
      REAL C00174(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FFYOFF"',
     *  ' ',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(28)
      RS1=RS1+C00169(I00001,I00002)
    2 CONTINUE
      C00174(I00002)=RS1-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 "FFYOFF"',
     *  ' ',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,
     *  C00121,C00122,C00172,C00175,
     *  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 C00121(SSZ(1))
      REAL C00122(SSZ(1))
      REAL C00172(SSZ(1))
      REAL C00175(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FINDTAX"',
     *  ' ',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=C00172(I00002)
      RS2=C00121(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00175(I00002)=RS3*C00122(I00002)
    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 "FINDTAX"',
     *  ' ',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,
     *  C00121,C00122,C00173,C00176,
     *  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 C00121(SSZ(1))
      REAL C00122(SSZ(1))
      REAL C00173(SSZ(1))
      REAL C00176(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FINDTAXON"',
     *  ' ',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=C00173(I00002)
      RS2=C00121(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00176(I00002)=RS3*C00122(I00002)
    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 "FINDTAXON"',
     *  ' ',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,
     *  C00121,C00122,C00174,C00177,
     *  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 C00121(SSZ(1))
      REAL C00122(SSZ(1))
      REAL C00174(SSZ(1))
      REAL C00177(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FINDTAXOFF"',
     *  ' ',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=C00174(I00002)
      RS2=C00121(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00177(I00002)=RS3*C00122(I00002)
    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 "FINDTAXOFF"',
     *  ' ',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,
     *  C00172,C00175,C00178,
     *  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 C00175(SSZ(1))
      REAL C00178(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FARMINCOME"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00178(I00002)=C00172(I00002)+C00175(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FARMINCOME"',
     *  ' ',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,
     *  C00173,C00176,C00179,
     *  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 C00173(SSZ(1))
      REAL C00176(SSZ(1))
      REAL C00179(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FARMINCOMEON"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00179(I00002)=C00173(I00002)+C00176(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FARMINCOMEON"',
     *  ' ',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,
     *  C00174,C00177,C00180,
     *  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 C00174(SSZ(1))
      REAL C00177(SSZ(1))
      REAL C00180(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FINCOMEOFF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(1)
      C00180(I00002)=C00174(I00002)+C00177(I00002)
    1 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FINCOMEOFF"',
     *  ' ',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,C00181,
     *  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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00181(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 "TFARMINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 1 I00002=1,SSZ(2)
      RS1=0.0
      DO 2 I00004=1,SSZ(15)
      RS2=0.0
      DO 3 I00001=1,SSZ(9)
      RS2=RS2+C00021(I00001,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),SSMP(SSMPST(1)-1+I00002))
    3 CONTINUE
      RS1=RS1+RS2
    2 CONTINUE
      C00181(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 "TFARMINC"',
     *  ' ',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,
     *  C00181,C00182,C00183,
     *  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 C00181(SSZ(2))
      REAL C00182(SSZ(3))
      REAL C00183(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 "AGFARMINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(2)
      DO 1 I00001=1,SSZ(3)
      C00183(I00001,I00002)=C00182(I00001)*C00181(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 "AGFARMINC"',
     *  ' ',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,
     *  C00183,C00184,C00185,
     *  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 C00183(SSZ(3),SSZ(2))
      REAL C00184(SSZ(4),SSZ(3))
      REAL C00185(SSZ(4),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 "DAGFARMINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      C00185(I00001,I00004,I00002)=C00184(I00001,I00004)*
     *  C00183(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 "DAGFARMINC"',
     *  ' ',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,
     *  C00186,C00191,
     *  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)
      LOGICAL ECHO1
      REAL C00186(SSZ(9),SSZ(4),SSZ(2))
      REAL C00191(SSZ(9),SSZ(4),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 "FFshr"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(9)
      C00191(I00011,I00001,SSMP(SSMPST(31)-1+1),I00002)=
     *  C00186(I00011,I00001,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 "FFshr"',
     *  ' ',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,
     *  C00187,C00191,
     *  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)
      LOGICAL ECHO1
      REAL C00187(SSZ(9),SSZ(4),SSZ(2))
      REAL C00191(SSZ(9),SSZ(4),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 "FFshr"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(9)
      C00191(I00011,I00001,SSMP(SSMPST(32)-1+1),I00002)=
     *  C00187(I00011,I00001,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 "FFshr"',
     *  ' ',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,
     *  C00188,C00191,
     *  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)
      LOGICAL ECHO1
      REAL C00188(SSZ(9),SSZ(4),SSZ(2))
      REAL C00191(SSZ(9),SSZ(4),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 "FFshr"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(9)
      C00191(I00011,I00001,SSMP(SSMPST(33)-1+1),I00002)=
     *  C00188(I00011,I00001,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 "FFshr"',
     *  ' ',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,
     *  C00189,C00191,
     *  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)
      LOGICAL ECHO1
      REAL C00189(SSZ(9),SSZ(4),SSZ(2))
      REAL C00191(SSZ(9),SSZ(4),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 "FFshr"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(9)
      C00191(I00011,I00001,SSMP(SSMPST(34)-1+1),I00002)=
     *  C00189(I00011,I00001,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 "FFshr"',
     *  ' ',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,
     *  C00190,C00191,
     *  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)
      LOGICAL ECHO1
      REAL C00190(SSZ(9),SSZ(4),SSZ(2))
      REAL C00191(SSZ(9),SSZ(4),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 "FFshr"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(9)
      C00191(I00011,I00001,SSMP(SSMPST(35)-1+1),I00002)=
     *  C00190(I00011,I00001,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 "FFshr"',
     *  ' ',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,
     *  C00185,C00191,C00192,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      LOGICAL ECHO1
      REAL C00185(SSZ(4),SSZ(3),SSZ(2))
      REAL C00191(SSZ(9),SSZ(4),SSZ(3),SSZ(2))
      REAL C00192(SSZ(9),SSZ(4),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 "FFINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 4 I00002=1,SSZ(2)
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(9)
      C00192(I00011,I00001,I00004,I00002)=
     *  C00191(I00011,I00001,I00004,I00002)*C00185(I00001,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FFINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00162')
      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(838).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FVA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(838).NE.'n') then
      CALL S00139(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(838),
     *  C00021,C00166,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(840).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NFVA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(840).NE.'n') then
      CALL S00140(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(840),
     *  C00165,C00166,C00167,
     *  ZDZVAL,NDZVAL,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(843).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NFVOA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(843).NE.'n') then
      CALL S00141(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(843),
     *  C00164,C00167,C00168,
     *  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(847).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NFVOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(847).NE.'n') then
      CALL S00142(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(847),
     *  C00168,C00169,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=14
       SSNO=30
       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,30,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(850).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NFCAPSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(850).NE.'n') then
      CALL S00143(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(850),
     *  C00033,C00169,C00170,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(852).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NFVDEP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(852).NE.'n') then
      CALL S00144(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(852),
     *  C00024,C00170,C00171,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(854).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FFY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(854).NE.'n') then
      CALL S00145(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(854),
     *  C00021,C00163,C00169,C00171,C00172,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(856).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FFYON',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(856).NE.'n') then
      CALL S00146(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(856),
     *  C00021,C00163,C00173,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(858).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FFYOFF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(858).NE.'n') then
      CALL S00147(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(858),
     *  C00169,C00171,C00174,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(866).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FINDTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(866).NE.'n') then
      CALL S00148(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(866),
     *  C00121,C00122,C00172,C00175,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(868).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FINDTAXON',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(868).NE.'n') then
      CALL S00149(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(868),
     *  C00121,C00122,C00173,C00176,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(870).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FINDTAXOFF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(870).NE.'n') then
      CALL S00150(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(870),
     *  C00121,C00122,C00174,C00177,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(872).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FARMINCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(872).NE.'n') then
      CALL S00151(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(872),
     *  C00172,C00175,C00178,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(874).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FARMINCOMEON',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(874).NE.'n') then
      CALL S00152(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(874),
     *  C00173,C00176,C00179,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(876).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FINCOMEOFF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(876).NE.'n') then
      CALL S00153(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(876),
     *  C00174,C00177,C00180,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(884).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TFARMINC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(884).NE.'n') then
      CALL S00154(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(884),
     *  C00021,C00181,
     *  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(888).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'AGFARMINC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(888).NE.'n') then
      CALL S00155(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(888),
     *  C00181,C00182,C00183,
     *  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(892).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DAGFARMINC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(892).NE.'n') then
      CALL S00156(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(892),
     *  C00183,C00184,C00185,
     *  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
      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 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=31
       SSNO=31
       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,31,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(906).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FFshr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(906).NE.'n') then
      CALL S00157(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(906),
     *  C00186,C00191,
     *  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=32
       SSNO=32
       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,32,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(909).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FFshr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(909).NE.'n') then
      CALL S00158(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(909),
     *  C00187,C00191,
     *  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=33
       SSNO=33
       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,33,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(912).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FFshr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(912).NE.'n') then
      CALL S00159(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(912),
     *  C00188,C00191,
     *  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=34
       SSNO=34
       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,34,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(915).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FFshr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(915).NE.'n') then
      CALL S00160(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(915),
     *  C00189,C00191,
     *  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=35
       SSNO=35
       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,35,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(918).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FFshr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(918).NE.'n') then
      CALL S00161(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(918),
     *  C00190,C00191,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(920).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FFINC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(920).NE.'n') then
      CALL S00162(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(920),
     *  C00185,C00191,C00192,
     *  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
      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('M00006')
      RETURN
      END
      SUBROUTINE S00163(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00193,C00198,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00012
      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 C00193(SSZ(4),SSZ(15),SSZ(2))
      REAL C00198(SSZ(4),SSZ(3),SSZ(15),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 "LandShrI"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00012=1,SSZ(15)
      DO 1 I00001=1,SSZ(4)
      C00198(I00001,SSMP(SSMPST(31)-1+1),I00012,I00002)=
     *  C00193(I00001,I00012,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 "LandShrI"',
     *  ' ',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,
     *  C00194,C00198,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00012
      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 C00194(SSZ(4),SSZ(15),SSZ(2))
      REAL C00198(SSZ(4),SSZ(3),SSZ(15),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 "LandShrI"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00012=1,SSZ(15)
      DO 1 I00001=1,SSZ(4)
      C00198(I00001,SSMP(SSMPST(32)-1+1),I00012,I00002)=
     *  C00194(I00001,I00012,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 "LandShrI"',
     *  ' ',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,
     *  C00195,C00198,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00012
      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 C00195(SSZ(4),SSZ(15),SSZ(2))
      REAL C00198(SSZ(4),SSZ(3),SSZ(15),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 "LandShrI"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00012=1,SSZ(15)
      DO 1 I00001=1,SSZ(4)
      C00198(I00001,SSMP(SSMPST(33)-1+1),I00012,I00002)=
     *  C00195(I00001,I00012,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 "LandShrI"',
     *  ' ',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,
     *  C00196,C00198,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00012
      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 C00196(SSZ(4),SSZ(15),SSZ(2))
      REAL C00198(SSZ(4),SSZ(3),SSZ(15),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 "LandShrI"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00012=1,SSZ(15)
      DO 1 I00001=1,SSZ(4)
      C00198(I00001,SSMP(SSMPST(34)-1+1),I00012,I00002)=
     *  C00196(I00001,I00012,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 "LandShrI"',
     *  ' ',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,
     *  C00197,C00198,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00012
      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 C00197(SSZ(4),SSZ(15),SSZ(2))
      REAL C00198(SSZ(4),SSZ(3),SSZ(15),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 "LandShrI"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00012=1,SSZ(15)
      DO 1 I00001=1,SSZ(4)
      C00198(I00001,SSMP(SSMPST(35)-1+1),I00012,I00002)=
     *  C00197(I00001,I00012,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 "LandShrI"',
     *  ' ',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,
     *  C00192,C00198,C00199,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00010
      INTEGER I00012
      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 C00192(SSZ(9),SSZ(4),SSZ(3),SSZ(2))
      REAL C00198(SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "FLINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 5 I00002=1,SSZ(2)
      DO 4 I00012=1,SSZ(15)
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00010=1,SSZ(13)
      C00199(I00010,I00001,I00004,I00012,I00002)=C00192(SSMP(SSMPST(26)-
     *  1+SSMP(SSMPST(28)-1+I00010)),I00001,I00004,I00002)*
     *  C00198(I00001,I00004,I00012,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
    5 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "FLINC"',
     *  ' ',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,
     *  C00192,C00199,C00200,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00010
      INTEGER I00011
      INTEGER I00012
      INTEGER 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 C00192(SSZ(9),SSZ(4),SSZ(3),SSZ(2))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL C00200(SSZ(4),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 "FarmInc"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 4 I00011=1,SSZ(28)
      RS1=RS1+C00192(SSMP(SSMPST(27)-1+I00011),I00001,I00004,I00002)
    4 CONTINUE
      RS2=0.0
      DO 6 I00012=1,SSZ(15)
      RS3=0.0
      DO 5 I00010=1,SSZ(13)
      RS3=RS3+C00199(I00010,I00001,I00004,I00012,I00002)
    5 CONTINUE
      RS2=RS2+RS3
    6 CONTINUE
      C00200(I00001,I00004,I00002)=RS1+RS2
    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 "FarmInc"',
     *  ' ',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,
     *  C00200,C00201,C00202,
     *  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 C00200(SSZ(4),SSZ(3),SSZ(2))
      REAL C00201(SSZ(4),SSZ(3),SSZ(2))
      REAL C00202(SSZ(4),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 "OFarmInc"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=1  -C00201(I00001,I00004,I00002)
      RS2=C00201(I00001,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00202(I00001,I00004,I00002)=C00200(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 "OFarmInc"',
     *  ' ',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,
     *  C00203,C00208,
     *  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)
      LOGICAL ECHO1
      REAL C00203(SSZ(9),SSZ(4),SSZ(2))
      REAL C00208(SSZ(9),SSZ(4),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 "OFacshr"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(9)
      C00208(I00011,I00001,SSMP(SSMPST(31)-1+1),I00002)=
     *  C00203(I00011,I00001,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 "OFacshr"',
     *  ' ',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,
     *  C00204,C00208,
     *  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)
      LOGICAL ECHO1
      REAL C00204(SSZ(9),SSZ(4),SSZ(2))
      REAL C00208(SSZ(9),SSZ(4),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 "OFacshr"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(9)
      C00208(I00011,I00001,SSMP(SSMPST(32)-1+1),I00002)=
     *  C00204(I00011,I00001,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 "OFacshr"',
     *  ' ',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,
     *  C00205,C00208,
     *  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)
      LOGICAL ECHO1
      REAL C00205(SSZ(9),SSZ(4),SSZ(2))
      REAL C00208(SSZ(9),SSZ(4),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 "OFacshr"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(9)
      C00208(I00011,I00001,SSMP(SSMPST(33)-1+1),I00002)=
     *  C00205(I00011,I00001,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 "OFacshr"',
     *  ' ',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,
     *  C00206,C00208,
     *  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)
      LOGICAL ECHO1
      REAL C00206(SSZ(9),SSZ(4),SSZ(2))
      REAL C00208(SSZ(9),SSZ(4),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 "OFacshr"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(9)
      C00208(I00011,I00001,SSMP(SSMPST(34)-1+1),I00002)=
     *  C00206(I00011,I00001,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 "OFacshr"',
     *  ' ',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,
     *  C00207,C00208,
     *  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)
      LOGICAL ECHO1
      REAL C00207(SSZ(9),SSZ(4),SSZ(2))
      REAL C00208(SSZ(9),SSZ(4),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 "OFacshr"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(9)
      C00208(I00011,I00001,SSMP(SSMPST(35)-1+1),I00002)=
     *  C00207(I00011,I00001,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 "OFacshr"',
     *  ' ',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,
     *  C00202,C00208,C00209,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      LOGICAL ECHO1
      REAL C00202(SSZ(4),SSZ(3),SSZ(2))
      REAL C00208(SSZ(9),SSZ(4),SSZ(3),SSZ(2))
      REAL C00209(SSZ(28),SSZ(4),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 "OFFInc"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 4 I00002=1,SSZ(2)
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(28)
      C00209(I00011,I00001,I00004,I00002)=C00208(SSMP(SSMPST(27)-1+
     *  I00011),I00001,I00004,I00002)*C00202(I00001,I00004,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "OFFInc"',
     *  ' ',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,
     *  C00033,C00192,C00210,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00013
      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 C00033(SSZ(12),SSZ(1))
      REAL C00192(SSZ(9),SSZ(4),SSZ(3),SSZ(2))
      REAL C00210(SSZ(4),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 "usFCAPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 4 I00013=1,SSZ(14)
      RS1=RS1+C00033(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(11)-
     *  1+I00013))),SSMP(SSMPST(1)-1+I00002))
    4 CONTINUE
      RS2=C00192(SSMP(SSMPST(29)-1+1),I00001,I00004,I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      C00210(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 "usFCAPSHR"',
     *  ' ',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,
     *  C00024,C00210,C00211,
     *  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(1))
      REAL C00210(SSZ(4),SSZ(3),SSZ(2))
      REAL C00211(SSZ(4),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 "usFVDEP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      C00211(I00001,I00004,I00002)=C00210(I00001,I00004,I00002)*
     *  C00024(SSMP(SSMPST(1)-1+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 "usFVDEP"',
     *  ' ',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,
     *  C00033,C00209,C00212,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00013
      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 C00033(SSZ(12),SSZ(1))
      REAL C00209(SSZ(28),SSZ(4),SSZ(3),SSZ(2))
      REAL C00212(SSZ(4),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 "usNFCAPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 4 I00013=1,SSZ(14)
      RS1=RS1+C00033(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(11)-
     *  1+I00013))),SSMP(SSMPST(1)-1+I00002))
    4 CONTINUE
      RS2=C00209(SSMP(SSMPST(36)-1+1),I00001,I00004,I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      C00212(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 "usNFCAPSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00179')
      RETURN
      END
      SUBROUTINE S00180(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00024,C00212,C00213,
     *  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(1))
      REAL C00212(SSZ(4),SSZ(3),SSZ(2))
      REAL C00213(SSZ(4),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 "usNFVDEP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      C00213(I00001,I00004,I00002)=C00212(I00001,I00004,I00002)*
     *  C00024(SSMP(SSMPST(1)-1+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 "usNFVDEP"',
     *  ' ',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,
     *  C00192,C00199,C00209,C00211,C00213,C00214,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00011
      INTEGER I00012
      INTEGER 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 C00192(SSZ(9),SSZ(4),SSZ(3),SSZ(2))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL C00209(SSZ(28),SSZ(4),SSZ(3),SSZ(2))
      REAL C00211(SSZ(4),SSZ(3),SSZ(2))
      REAL C00213(SSZ(4),SSZ(3),SSZ(2))
      REAL C00214(SSZ(4),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 "usFFY"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 4 I00012=1,SSZ(15)
      RS1=RS1+C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)
    4 CONTINUE
      RS2=0.0
      DO 5 I00011=1,SSZ(28)
      RS2=RS2+C00192(SSMP(SSMPST(27)-1+I00011),I00001,I00004,I00002)
    5 CONTINUE
      RS3=0.0
      DO 6 I00011=1,SSZ(28)
      RS3=RS3+C00209(I00011,I00001,I00004,I00002)
    6 CONTINUE
      C00214(I00001,I00004,I00002)=RS1+RS2+RS3-
     *  (C00211(I00001,I00004,I00002)+C00213(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 "usFFY"',
     *  ' ',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,
     *  C00192,C00199,C00213,C00215,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00011
      INTEGER I00012
      INTEGER 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 C00192(SSZ(9),SSZ(4),SSZ(3),SSZ(2))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL C00213(SSZ(4),SSZ(3),SSZ(2))
      REAL C00215(SSZ(4),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 "usFFYON"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 4 I00012=1,SSZ(15)
      RS1=RS1+C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)
    4 CONTINUE
      RS2=0.0
      DO 5 I00011=1,SSZ(28)
      RS2=RS2+C00192(SSMP(SSMPST(27)-1+I00011),I00001,I00004,I00002)
    5 CONTINUE
      C00215(I00001,I00004,I00002)=RS1+RS2+C00213(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 "usFFYON"',
     *  ' ',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,
     *  C00209,C00213,C00216,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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 C00209(SSZ(28),SSZ(4),SSZ(3),SSZ(2))
      REAL C00213(SSZ(4),SSZ(3),SSZ(2))
      REAL C00216(SSZ(4),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 "usFFYOFF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 4 I00011=1,SSZ(28)
      RS1=RS1+C00209(I00011,I00001,I00004,I00002)
    4 CONTINUE
      C00216(I00001,I00004,I00002)=RS1-C00213(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 "usFFYOFF"',
     *  ' ',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,
     *  C00121,C00122,C00214,C00217,
     *  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 C00121(SSZ(1))
      REAL C00122(SSZ(1))
      REAL C00214(SSZ(4),SSZ(3),SSZ(2))
      REAL C00217(SSZ(4),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 "usFINDTAX"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00214(I00001,I00004,I00002)
      RS2=C00121(SSMP(SSMPST(1)-1+I00002))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00217(I00001,I00004,I00002)=RS3*C00122(SSMP(SSMPST(1)-1+I00002))
    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 "usFINDTAX"',
     *  ' ',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,
     *  C00121,C00122,C00215,C00218,
     *  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 C00121(SSZ(1))
      REAL C00122(SSZ(1))
      REAL C00215(SSZ(4),SSZ(3),SSZ(2))
      REAL C00218(SSZ(4),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 "usFINDTAXON"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00215(I00001,I00004,I00002)
      RS2=C00121(SSMP(SSMPST(1)-1+I00002))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00218(I00001,I00004,I00002)=RS3*C00122(SSMP(SSMPST(1)-1+I00002))
    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 "usFINDTAXON"',
     *  ' ',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,
     *  C00121,C00122,C00216,C00219,
     *  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 C00121(SSZ(1))
      REAL C00122(SSZ(1))
      REAL C00216(SSZ(4),SSZ(3),SSZ(2))
      REAL C00219(SSZ(4),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 "usFINDTAXOFF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=C00216(I00001,I00004,I00002)
      RS2=C00121(SSMP(SSMPST(1)-1+I00002))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00219(I00001,I00004,I00002)=RS3*C00122(SSMP(SSMPST(1)-1+I00002))
    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 "usFINDTAXOFF"',
     *  ' ',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,
     *  C00214,C00217,C00220,
     *  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 C00214(SSZ(4),SSZ(3),SSZ(2))
      REAL C00217(SSZ(4),SSZ(3),SSZ(2))
      REAL C00220(SSZ(4),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 "usFARMINCOME"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      C00220(I00001,I00004,I00002)=C00214(I00001,I00004,I00002)+
     *  C00217(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 "usFARMINCOME"',
     *  ' ',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,
     *  C00215,C00218,C00221,
     *  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 C00215(SSZ(4),SSZ(3),SSZ(2))
      REAL C00218(SSZ(4),SSZ(3),SSZ(2))
      REAL C00221(SSZ(4),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 "usFARMINCON"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      C00221(I00001,I00004,I00002)=C00215(I00001,I00004,I00002)+
     *  C00218(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 "usFARMINCON"',
     *  ' ',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,
     *  C00216,C00219,C00222,
     *  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 C00216(SSZ(4),SSZ(3),SSZ(2))
      REAL C00219(SSZ(4),SSZ(3),SSZ(2))
      REAL C00222(SSZ(4),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 "usFINCOMEOFF"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      C00222(I00001,I00004,I00002)=C00216(I00001,I00004,I00002)+
     *  C00219(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 "usFINCOMEOFF"',
     *  ' ',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,
     *  C00067,C00068,C00223,C00225,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      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 C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00223(SSZ(4),SSZ(3),SSZ(2))
      REAL C00225(SSZ(30),SSZ(4),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 "aPHIUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(2)
      DO 3 I00007=1,SSZ(3)
      DO 2 I00014=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      RS1=C00067(I00001,SSMP(SSMPST(1)-1+I00002))+
     *  C00068(I00001,SSMP(SSMPST(1)-1+I00002))*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))
      RS2=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00225(I00001,I00014,I00007,I00002)=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 "aPHIUSA"',
     *  ' ',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,
     *  C00067,C00068,C00069,C00223,C00224,C00226,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      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,RS11
      LOGICAL ECHO1
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00223(SSZ(4),SSZ(3),SSZ(2))
      REAL C00224(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00226(SSZ(4),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 "aEPSINUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(2)
      DO 2 I00007=1,SSZ(3)
      DO 1 I00014=1,SSZ(4)
      RS1=0.0
      DO 4 I00001=1,SSZ(30)
      RS2=REAL(C00224(I00001,I00014,I00007,I00002)-
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002)))
      IF(RS2.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      RS1=RS1+(C00068(I00001,SSMP(SSMPST(1)-1+I00002))-
     *  C00067(I00001,SSMP(SSMPST(1)-1+I00002)))*LOG(RS2)
    4 CONTINUE
      RS3=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      RS4=2
      IF(RS3.GT.0.0) THEN
        RS5=RS3**RS4
      ELSE IF(RS3.EQ.0.0 .AND. RS4.GT.0.0) THEN
        RS5=0.0
      ELSE IF(RS3.EQ.0.0 .AND. RS4.EQ.0.0) THEN
        RS5=1.0
        IER=11
      ELSE IF(RS3.EQ.0.0 .AND. RS4.LT.0.0) THEN
        RS5=1.0
        IER=12
      ELSE
        IF(RS4.EQ.0.0) THEN
          RS5=1.0
          IER=13
        ELSE IF(INT(RS4).EQ.RS4) THEN
          RS5=RS3**INT(RS4)
        ELSE
          RS5=1.0
          IER=14
        END IF
      END IF
      RS6=RS5
      RS7=EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS9=1
      RS10=RS1-(RS8)
      IF(RS10.NE.0.0) THEN
        RS11=RS9/RS10
      ELSE
        RS11=1.0
        IER=2
      END IF
      C00226(I00014,I00007,I00002)=RS11
    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 "aEPSINUSA"',
     *  ' ',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,
     *  C00064,C00069,C00224,C00225,C00227,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER I00007
      INTEGER I00014
      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 C00064(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00224(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00225(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00227(SSZ(30),SSZ(4),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 "aABSHAREUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(2)
      DO 3 I00007=1,SSZ(3)
      DO 2 I00014=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      RS1=0.0
      DO 5 I00005=1,SSZ(30)
      RS1=RS1+C00064(I00005,SSMP(SSMPST(1)-1+I00002))*
     *  C00069(I00005,SSMP(SSMPST(1)-1+I00002))
    5 CONTINUE
      RS2=0.0
      DO 6 I00005=1,SSZ(30)
      RS2=RS2+C00224(I00005,I00014,I00007,I00002)*
     *  C00064(I00005,SSMP(SSMPST(1)-1+I00002))
    6 CONTINUE
      RS3=C00064(I00001,SSMP(SSMPST(1)-1+I00002))*
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002))-
     *  C00225(I00001,I00014,I00007,I00002)*RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE
        RS5=1.0
        IER=2
      END IF
      C00227(I00001,I00014,I00007,I00002)=
     *  C00225(I00001,I00014,I00007,I00002)+RS5
    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 "aABSHAREUSA"',
     *  ' ',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,
     *  C00067,C00068,C00225,C00226,C00228,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      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 C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00225(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00226(SSZ(4),SSZ(3),SSZ(2))
      REAL C00228(SSZ(30),SSZ(4),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 "aMBSHAREUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 4 I00002=1,SSZ(2)
      DO 3 I00007=1,SSZ(3)
      DO 2 I00014=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      C00228(I00001,I00014,I00007,I00002)=
     *  C00225(I00001,I00014,I00007,I00002)-
     *  (C00068(I00001,SSMP(SSMPST(1)-1+I00002))-
     *  C00067(I00001,SSMP(SSMPST(1)-1+I00002)))*
     *  C00226(I00014,I00007,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "aMBSHAREUSA"',
     *  ' ',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,
     *  C00064,C00069,C00224,C00225,C00227,C00229,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00007
      INTEGER I00009
      INTEGER I00014
      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
      LOGICAL ECHO1
      REAL C00064(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00224(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00225(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00227(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00229(SSZ(30),SSZ(30),SSZ(4),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 "aAPEUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 5 I00002=1,SSZ(2)
      DO 4 I00007=1,SSZ(3)
      DO 3 I00014=1,SSZ(4)
      DO 2 I00004=1,SSZ(30)
      DO 1 I00001=1,SSZ(30)
      RS1=0.0
      DO 6 I00009=1,SSZ(30)
      RS1=RS1+C00064(I00009,SSMP(SSMPST(1)-1+I00002))*
     *  C00224(I00009,I00014,I00007,I00002)-
     *  C00064(I00009,SSMP(SSMPST(1)-1+I00002))*
     *  C00069(I00009,SSMP(SSMPST(1)-1+I00002))
    6 CONTINUE
      RS2=0.0
      DO 7 I00009=1,SSZ(30)
      RS2=RS2+C00064(I00009,SSMP(SSMPST(1)-1+I00002))*
     *  C00224(I00009,I00014,I00007,I00002)
    7 CONTINUE
      RS3=RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE
        RS5=1.0
        IER=2
      END IF
      RS6=RS5*C00225(I00001,I00014,I00007,I00002)*
     *  C00225(I00004,I00014,I00007,I00002)
      RS7=C00227(I00001,I00014,I00007,I00002)*
     *  C00227(I00004,I00014,I00007,I00002)
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      C00229(I00001,I00004,I00014,I00007,I00002)=RS8
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
    5 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 "aAPEUSA"',
     *  ' ',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,
     *  C00227,C00229,C00230,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00007
      INTEGER I00014
      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
      REAL C00227(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00229(SSZ(30),SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00230(SSZ(30),SSZ(4),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 "aAPEiiUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(2)
      DO 3 I00007=1,SSZ(3)
      DO 2 I00014=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      RS1=0.0
      DO 5 I00004=1,SSZ(30)
      LG1=I00004.NE.I00001
      IF(.NOT.LG1) GOTO     5
      RS1=RS1+C00229(I00001,I00004,I00014,I00007,I00002)*
     *  C00227(I00004,I00014,I00007,I00002)
    5 CONTINUE
      RS2=-RS1
      RS3=C00227(I00001,I00014,I00007,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      C00230(I00001,I00014,I00007,I00002)=RS4
    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 "aAPEiiUSA"',
     *  ' ',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,
     *  C00229,C00230,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      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 C00229(SSZ(30),SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00230(SSZ(30),SSZ(4),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 "aAPEUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 4 I00002=1,SSZ(2)
      DO 3 I00007=1,SSZ(3)
      DO 2 I00014=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      C00229(I00001,I00001,I00014,I00007,I00002)=
     *  C00230(I00001,I00014,I00007,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "aAPEUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00196')
      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(934).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'LandShrI',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(934).NE.'n') then
      CALL S00163(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(934),
     *  C00193,C00198,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(935).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'LandShrI',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(935).NE.'n') then
      CALL S00164(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(935),
     *  C00194,C00198,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(936).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'LandShrI',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(936).NE.'n') then
      CALL S00165(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(936),
     *  C00195,C00198,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(937).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'LandShrI',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(937).NE.'n') then
      CALL S00166(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(937),
     *  C00196,C00198,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(938).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'LandShrI',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(938).NE.'n') then
      CALL S00167(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(938),
     *  C00197,C00198,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(940).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FLINC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(940).NE.'n') then
      CALL S00168(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(940),
     *  C00192,C00198,C00199,
     *  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') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FarmInc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(944).NE.'n') then
      CALL S00169(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(944),
     *  C00192,C00199,C00200,
     *  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(948).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'OFarmInc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(948).NE.'n') then
      CALL S00170(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(948),
     *  C00200,C00201,C00202,
     *  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
      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(960).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'OFacshr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(960).NE.'n') then
      CALL S00171(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(960),
     *  C00203,C00208,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(961).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'OFacshr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(961).NE.'n') then
      CALL S00172(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(961),
     *  C00204,C00208,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(962).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'OFacshr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(962).NE.'n') then
      CALL S00173(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(962),
     *  C00205,C00208,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(963).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'OFacshr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(963).NE.'n') then
      CALL S00174(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(963),
     *  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''',
     *    'OFacshr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(964).NE.'n') then
      CALL S00175(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(964),
     *  C00207,C00208,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(966).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'OFFInc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(966).NE.'n') then
      CALL S00176(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(966),
     *  C00202,C00208,C00209,
     *  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(970).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usFCAPSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(970).NE.'n') then
      CALL S00177(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(970),
     *  C00033,C00192,C00210,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(972).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usFVDEP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(972).NE.'n') then
      CALL S00178(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(972),
     *  C00024,C00210,C00211,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=29
       SSNO=36
       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,36,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(975).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usNFCAPSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(975).NE.'n') then
      CALL S00179(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(975),
     *  C00033,C00209,C00212,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(977).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usNFVDEP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(977).NE.'n') then
      CALL S00180(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(977),
     *  C00024,C00212,C00213,
     *  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=36
       SSNO=37
       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,37,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(981).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usFFY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(981).NE.'n') then
      CALL S00181(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(981),
     *  C00192,C00199,C00209,C00211,C00213,C00214,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(983).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usFFYON',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(983).NE.'n') then
      CALL S00182(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(983),
     *  C00192,C00199,C00213,C00215,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(985).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usFFYOFF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(985).NE.'n') then
      CALL S00183(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(985),
     *  C00209,C00213,C00216,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(993).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usFINDTAX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(993).NE.'n') then
      CALL S00184(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(993),
     *  C00121,C00122,C00214,C00217,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(995).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usFINDTAXON',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(995).NE.'n') then
      CALL S00185(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(995),
     *  C00121,C00122,C00215,C00218,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(997).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usFINDTAXOFF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(997).NE.'n') then
      CALL S00186(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(997),
     *  C00121,C00122,C00216,C00219,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(999).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usFARMINCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(999).NE.'n') then
      CALL S00187(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(999),
     *  C00214,C00217,C00220,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1001).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usFARMINCON',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1001).NE.'n') then
      CALL S00188(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1001),
     *  C00215,C00218,C00221,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1003).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'usFINCOMEOFF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1003).NE.'n') then
      CALL S00189(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1003),
     *  C00216,C00219,C00222,
     *  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(1030).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aPHIUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1030).NE.'n') then
      CALL S00190(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1030),
     *  C00067,C00068,C00223,C00225,
     *  ZDZVAL,NDZVAL,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(1035).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEPSINUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1035).NE.'n') then
      CALL S00191(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1035),
     *  C00067,C00068,C00069,C00223,C00224,C00226,
     *  ZDZVAL,NDZVAL,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(1039).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aABSHAREUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1039).NE.'n') then
      CALL S00192(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1039),
     *  C00064,C00069,C00224,C00225,C00227,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1041).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aMBSHAREUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1041).NE.'n') then
      CALL S00193(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1041),
     *  C00067,C00068,C00225,C00226,C00228,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1043).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aAPEUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1043).NE.'n') then
      CALL S00194(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1043),
     *  C00064,C00069,C00224,C00225,C00227,C00229,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1045).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aAPEiiUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1045).NE.'n') then
      CALL S00195(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1045),
     *  C00227,C00229,C00230,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1046).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aAPEUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1046).NE.'n') then
      CALL S00196(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1046),
     *  C00229,C00230,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00007')
      RETURN
      END
      SUBROUTINE S00197(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00227,C00228,C00231,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      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 C00227(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00228(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00231(SSZ(30),SSZ(4),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 "aEYUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(2)
      DO 3 I00007=1,SSZ(3)
      DO 2 I00014=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      RS1=C00228(I00001,I00014,I00007,I00002)
      RS2=C00227(I00001,I00014,I00007,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00231(I00001,I00014,I00007,I00002)=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 "aEYUSA"',
     *  ' ',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,
     *  C00227,C00229,C00231,C00232,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00007
      INTEGER I00014
      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 C00227(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00229(SSZ(30),SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00231(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00232(SSZ(30),SSZ(30),SSZ(4),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 "aEPUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 5 I00002=1,SSZ(2)
      DO 4 I00007=1,SSZ(3)
      DO 3 I00014=1,SSZ(4)
      DO 2 I00004=1,SSZ(30)
      DO 1 I00001=1,SSZ(30)
      C00232(I00001,I00004,I00014,I00007,I00002)=
     *  C00227(I00004,I00014,I00007,I00002)*
     *  (C00229(I00001,I00004,I00014,I00007,I00002)-
     *  C00231(I00001,I00014,I00007,I00002))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
    5 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "aEPUSA"',
     *  ' ',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,
     *  C00064,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)
      LOGICAL ECHO1
      REAL C00064(SSZ(30),SSZ(1))
      REAL C00233(SSZ(30),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aPP0"',
     *  ' ',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(30)
      C00233(I00001,I00002)=C00064(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 "aPP0"',
     *  ' ',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,
     *  C00224,C00234,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      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 C00224(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00234(SSZ(30),SSZ(4),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 "aQUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 4 I00002=1,SSZ(2)
      DO 3 I00007=1,SSZ(3)
      DO 2 I00014=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      C00234(I00001,I00014,I00007,I00002)=
     *  C00224(I00001,I00014,I00007,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "aQUSAEV"',
     *  ' ',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,
     *  C00067,C00068,C00223,C00235,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      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 C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00223(SSZ(4),SSZ(3),SSZ(2))
      REAL C00235(SSZ(30),SSZ(4),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 "aPHIUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(2)
      DO 3 I00007=1,SSZ(3)
      DO 2 I00014=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      RS1=C00067(I00001,SSMP(SSMPST(1)-1+I00002))+
     *  C00068(I00001,SSMP(SSMPST(1)-1+I00002))*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))
      RS2=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00235(I00001,I00014,I00007,I00002)=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 "aPHIUSAEV"',
     *  ' ',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,
     *  C00067,C00068,C00069,C00223,C00234,C00236,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      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,RS11
      LOGICAL ECHO1
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00223(SSZ(4),SSZ(3),SSZ(2))
      REAL C00234(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00236(SSZ(4),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 "aEPSINUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(2)
      DO 2 I00007=1,SSZ(3)
      DO 1 I00014=1,SSZ(4)
      RS1=0.0
      DO 4 I00001=1,SSZ(30)
      RS2=REAL(C00234(I00001,I00014,I00007,I00002)-
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002)))
      IF(RS2.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      RS1=RS1+(C00068(I00001,SSMP(SSMPST(1)-1+I00002))-
     *  C00067(I00001,SSMP(SSMPST(1)-1+I00002)))*LOG(RS2)
    4 CONTINUE
      RS3=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      RS4=2
      IF(RS3.GT.0.0) THEN
        RS5=RS3**RS4
      ELSE IF(RS3.EQ.0.0 .AND. RS4.GT.0.0) THEN
        RS5=0.0
      ELSE IF(RS3.EQ.0.0 .AND. RS4.EQ.0.0) THEN
        RS5=1.0
        IER=11
      ELSE IF(RS3.EQ.0.0 .AND. RS4.LT.0.0) THEN
        RS5=1.0
        IER=12
      ELSE
        IF(RS4.EQ.0.0) THEN
          RS5=1.0
          IER=13
        ELSE IF(INT(RS4).EQ.RS4) THEN
          RS5=RS3**INT(RS4)
        ELSE
          RS5=1.0
          IER=14
        END IF
      END IF
      RS6=RS5
      RS7=EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS9=1
      RS10=RS1-(RS8)
      IF(RS10.NE.0.0) THEN
        RS11=RS9/RS10
      ELSE
        RS11=1.0
        IER=2
      END IF
      C00236(I00014,I00007,I00002)=RS11
    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 "aEPSINUSAEV"',
     *  ' ',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,
     *  C00069,C00233,C00234,C00235,C00237,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER I00007
      INTEGER I00014
      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 C00069(SSZ(30),SSZ(1))
      REAL C00233(SSZ(30),SSZ(1))
      REAL C00234(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00235(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00237(SSZ(30),SSZ(4),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 "aABSHRUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(2)
      DO 3 I00007=1,SSZ(3)
      DO 2 I00014=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      RS1=0.0
      DO 5 I00005=1,SSZ(30)
      RS1=RS1+C00233(I00005,SSMP(SSMPST(1)-1+I00002))*
     *  C00069(I00005,SSMP(SSMPST(1)-1+I00002))
    5 CONTINUE
      RS2=0.0
      DO 6 I00005=1,SSZ(30)
      RS2=RS2+C00234(I00005,I00014,I00007,I00002)*
     *  C00233(I00005,SSMP(SSMPST(1)-1+I00002))
    6 CONTINUE
      RS3=C00233(I00001,SSMP(SSMPST(1)-1+I00002))*
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002))-
     *  C00235(I00001,I00014,I00007,I00002)*RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE
        RS5=1.0
        IER=2
      END IF
      C00237(I00001,I00014,I00007,I00002)=
     *  C00235(I00001,I00014,I00007,I00002)+RS5
    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 "aABSHRUSAEV"',
     *  ' ',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,
     *  C00067,C00068,C00235,C00236,C00238,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      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 C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00235(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00236(SSZ(4),SSZ(3),SSZ(2))
      REAL C00238(SSZ(30),SSZ(4),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 "aMBSHRUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 4 I00002=1,SSZ(2)
      DO 3 I00007=1,SSZ(3)
      DO 2 I00014=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      C00238(I00001,I00014,I00007,I00002)=
     *  C00235(I00001,I00014,I00007,I00002)-
     *  (C00068(I00001,SSMP(SSMPST(1)-1+I00002))-
     *  C00067(I00001,SSMP(SSMPST(1)-1+I00002)))*
     *  C00236(I00014,I00007,I00002)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "aMBSHRUSAEV"',
     *  ' ',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,
     *  C00237,C00238,C00239,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      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 C00237(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00238(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00239(SSZ(30),SSZ(4),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 "aEYUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(2)
      DO 3 I00007=1,SSZ(3)
      DO 2 I00014=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      RS1=C00238(I00001,I00014,I00007,I00002)
      RS2=C00237(I00001,I00014,I00007,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00239(I00001,I00014,I00007,I00002)=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 "aEYUSAEV"',
     *  ' ',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,
     *  C00067,C00068,C00240,C00242,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00015
      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 C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00240(SSZ(39),SSZ(40))
      REAL C00242(SSZ(39),SSZ(30),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aPHIUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(40)
      DO 2 I00001=1,SSZ(30)
      DO 1 I00015=1,SSZ(39)
      RS1=C00067(I00001,SSMP(SSMPST(38)-1+I00002))+
     *  C00068(I00001,SSMP(SSMPST(38)-1+I00002))*
     *  EXP(REAL(C00240(I00015,I00002)))
      RS2=1  +EXP(REAL(C00240(I00015,I00002)))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00242(I00015,I00001,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 "aPHIUP"',
     *  ' ',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,
     *  C00067,C00068,C00069,C00240,C00241,C00243,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00015
      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,RS11
      LOGICAL ECHO1
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00240(SSZ(39),SSZ(40))
      REAL C00241(SSZ(39),SSZ(30),SSZ(40))
      REAL C00243(SSZ(39),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aEPSINUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(40)
      DO 1 I00015=1,SSZ(39)
      RS1=0.0
      DO 3 I00001=1,SSZ(30)
      RS2=REAL(C00241(I00015,I00001,I00002)-
     *  C00069(I00001,SSMP(SSMPST(38)-1+I00002)))
      IF(RS2.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      RS1=RS1+(C00068(I00001,SSMP(SSMPST(38)-1+I00002))-
     *  C00067(I00001,SSMP(SSMPST(38)-1+I00002)))*LOG(RS2)
    3 CONTINUE
      RS3=1  +EXP(REAL(C00240(I00015,I00002)))
      RS4=2
      IF(RS3.GT.0.0) THEN
        RS5=RS3**RS4
      ELSE IF(RS3.EQ.0.0 .AND. RS4.GT.0.0) THEN
        RS5=0.0
      ELSE IF(RS3.EQ.0.0 .AND. RS4.EQ.0.0) THEN
        RS5=1.0
        IER=11
      ELSE IF(RS3.EQ.0.0 .AND. RS4.LT.0.0) THEN
        RS5=1.0
        IER=12
      ELSE
        IF(RS4.EQ.0.0) THEN
          RS5=1.0
          IER=13
        ELSE IF(INT(RS4).EQ.RS4) THEN
          RS5=RS3**INT(RS4)
        ELSE
          RS5=1.0
          IER=14
        END IF
      END IF
      RS6=RS5
      RS7=EXP(REAL(C00240(I00015,I00002)))
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS9=1
      RS10=RS1-(RS8)
      IF(RS10.NE.0.0) THEN
        RS11=RS9/RS10
      ELSE
        RS11=1.0
        IER=2
      END IF
      C00243(I00015,I00002)=RS11
    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 "aEPSINUP"',
     *  ' ',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,
     *  C00064,C00069,C00241,C00242,C00244,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      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 C00064(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00241(SSZ(39),SSZ(30),SSZ(40))
      REAL C00242(SSZ(39),SSZ(30),SSZ(40))
      REAL C00244(SSZ(39),SSZ(30),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aABSHAREUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(40)
      DO 2 I00001=1,SSZ(30)
      DO 1 I00015=1,SSZ(39)
      RS1=0.0
      DO 4 I00007=1,SSZ(30)
      RS1=RS1+C00064(I00007,SSMP(SSMPST(38)-1+I00002))*
     *  C00069(I00007,SSMP(SSMPST(38)-1+I00002))
    4 CONTINUE
      RS2=0.0
      DO 5 I00007=1,SSZ(30)
      RS2=RS2+C00241(I00015,I00007,I00002)*
     *  C00064(I00007,SSMP(SSMPST(38)-1+I00002))
    5 CONTINUE
      RS3=C00064(I00001,SSMP(SSMPST(38)-1+I00002))*
     *  C00069(I00001,SSMP(SSMPST(38)-1+I00002))-
     *  C00242(I00015,I00001,I00002)*RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE
        RS5=1.0
        IER=2
      END IF
      C00244(I00015,I00001,I00002)=C00242(I00015,I00001,I00002)+RS5
    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 "aABSHAREUP"',
     *  ' ',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,
     *  C00067,C00068,C00242,C00243,C00245,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00015
      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 C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00242(SSZ(39),SSZ(30),SSZ(40))
      REAL C00243(SSZ(39),SSZ(40))
      REAL C00245(SSZ(39),SSZ(30),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aMBSHAREUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(40)
      DO 2 I00001=1,SSZ(30)
      DO 1 I00015=1,SSZ(39)
      C00245(I00015,I00001,I00002)=C00242(I00015,I00001,I00002)-
     *  (C00068(I00001,SSMP(SSMPST(38)-1+I00002))-
     *  C00067(I00001,SSMP(SSMPST(38)-1+I00002)))*C00243(I00015,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 "aMBSHAREUP"',
     *  ' ',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,
     *  C00064,C00069,C00241,C00242,C00244,C00246,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00009
      INTEGER I00015
      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
      LOGICAL ECHO1
      REAL C00064(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00241(SSZ(39),SSZ(30),SSZ(40))
      REAL C00242(SSZ(39),SSZ(30),SSZ(40))
      REAL C00244(SSZ(39),SSZ(30),SSZ(40))
      REAL C00246(SSZ(39),SSZ(30),SSZ(30),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aAPEUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 4 I00002=1,SSZ(40)
      DO 3 I00007=1,SSZ(30)
      DO 2 I00001=1,SSZ(30)
      DO 1 I00015=1,SSZ(39)
      RS1=0.0
      DO 5 I00009=1,SSZ(30)
      RS1=RS1+C00064(I00009,SSMP(SSMPST(38)-1+I00002))*
     *  C00241(I00015,I00009,I00002)-C00064(I00009,SSMP(SSMPST(38)-1+
     *  I00002))*C00069(I00009,SSMP(SSMPST(38)-1+I00002))
    5 CONTINUE
      RS2=0.0
      DO 6 I00009=1,SSZ(30)
      RS2=RS2+C00064(I00009,SSMP(SSMPST(38)-1+I00002))*
     *  C00241(I00015,I00009,I00002)
    6 CONTINUE
      RS3=RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE
        RS5=1.0
        IER=2
      END IF
      RS6=RS5*C00242(I00015,I00001,I00002)*C00242(I00015,I00007,I00002)
      RS7=C00244(I00015,I00001,I00002)*C00244(I00015,I00007,I00002)
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      C00246(I00015,I00001,I00007,I00002)=RS8
    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 "aAPEUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00210')
      RETURN
      END
      SUBROUTINE S00211(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00244,C00246,C00247,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      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
      REAL C00244(SSZ(39),SSZ(30),SSZ(40))
      REAL C00246(SSZ(39),SSZ(30),SSZ(30),SSZ(40))
      REAL C00247(SSZ(39),SSZ(30),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aAPEiiUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(40)
      DO 2 I00001=1,SSZ(30)
      DO 1 I00015=1,SSZ(39)
      RS1=0.0
      DO 4 I00007=1,SSZ(30)
      LG1=I00007.NE.I00001
      IF(.NOT.LG1) GOTO     4
      RS1=RS1+C00246(I00015,I00001,I00007,I00002)*
     *  C00244(I00015,I00007,I00002)
    4 CONTINUE
      RS2=-RS1
      RS3=C00244(I00015,I00001,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      C00247(I00015,I00001,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 "aAPEiiUP"',
     *  ' ',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,
     *  C00246,C00247,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00015
      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 C00246(SSZ(39),SSZ(30),SSZ(30),SSZ(40))
      REAL C00247(SSZ(39),SSZ(30),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aAPEUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(40)
      DO 2 I00001=1,SSZ(30)
      DO 1 I00015=1,SSZ(39)
      C00246(I00015,I00001,I00001,I00002)=C00247(I00015,I00001,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 "aAPEUP"',
     *  ' ',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,
     *  C00244,C00245,C00248,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00015
      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 C00244(SSZ(39),SSZ(30),SSZ(40))
      REAL C00245(SSZ(39),SSZ(30),SSZ(40))
      REAL C00248(SSZ(39),SSZ(30),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aEYUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(40)
      DO 2 I00001=1,SSZ(30)
      DO 1 I00015=1,SSZ(39)
      RS1=C00245(I00015,I00001,I00002)
      RS2=C00244(I00015,I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00248(I00015,I00001,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 "aEYUP"',
     *  ' ',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,
     *  C00244,C00246,C00248,C00249,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      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 C00244(SSZ(39),SSZ(30),SSZ(40))
      REAL C00246(SSZ(39),SSZ(30),SSZ(30),SSZ(40))
      REAL C00248(SSZ(39),SSZ(30),SSZ(40))
      REAL C00249(SSZ(39),SSZ(30),SSZ(30),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "aEPUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 4 I00002=1,SSZ(40)
      DO 3 I00007=1,SSZ(30)
      DO 2 I00001=1,SSZ(30)
      DO 1 I00015=1,SSZ(39)
      C00249(I00015,I00001,I00007,I00002)=C00244(I00015,I00007,I00002)*
     *  (C00246(I00015,I00001,I00007,I00002)-
     *  C00248(I00015,I00001,I00002))
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      IF(IER.NE.0) THEN
        CALL TGIER('fm',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating formula for coefficient "aEPUP"',
     *  ' ',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,
     *  C00250,C00251,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER 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 C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00251(SSZ(39),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "REGHCOUNT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(40)
      DO 1 I00015=1,SSZ(39)
      RS1=0.0
      DO 3 I00007=1,SSZ(37)
      RS1=RS1+C00250(I00015,I00002,I00007)
    3 CONTINUE
      C00251(I00015,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 "REGHCOUNT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00215')
      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(1048).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEYUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1048).NE.'n') then
      CALL S00197(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1048),
     *  C00227,C00228,C00231,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1050).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEPUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1050).NE.'n') then
      CALL S00198(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1050),
     *  C00227,C00229,C00231,C00232,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1054).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aPP0',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1054).NE.'n') then
      CALL S00199(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1054),
     *  C00064,C00233,
     *  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(1058).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aQUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1058).NE.'n') then
      CALL S00200(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1058),
     *  C00224,C00234,
     *  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(1062).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aPHIUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1062).NE.'n') then
      CALL S00201(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1062),
     *  C00067,C00068,C00223,C00235,
     *  ZDZVAL,NDZVAL,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(1067).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEPSINUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1067).NE.'n') then
      CALL S00202(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1067),
     *  C00067,C00068,C00069,C00223,C00234,C00236,
     *  ZDZVAL,NDZVAL,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(1071).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aABSHRUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1071).NE.'n') then
      CALL S00203(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1071),
     *  C00069,C00233,C00234,C00235,C00237,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1073).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aMBSHRUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1073).NE.'n') then
      CALL S00204(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1073),
     *  C00067,C00068,C00235,C00236,C00238,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1075).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEYUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1075).NE.'n') then
      CALL S00205(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1075),
     *  C00237,C00238,C00239,
     *  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
      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
      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(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(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(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(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(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(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(257,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.OR.POSTSIMPASS2) THEN
       LITSN=40
       SSNO=38
       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,38,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 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(1091).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aPHIUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1091).NE.'n') then
      CALL S00206(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1091),
     *  C00067,C00068,C00240,C00242,
     *  ZDZVAL,NDZVAL,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(1096).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEPSINUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1096).NE.'n') then
      CALL S00207(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1096),
     *  C00067,C00068,C00069,C00240,C00241,C00243,
     *  ZDZVAL,NDZVAL,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(1100).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aABSHAREUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1100).NE.'n') then
      CALL S00208(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1100),
     *  C00064,C00069,C00241,C00242,C00244,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1102).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aMBSHAREUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1102).NE.'n') then
      CALL S00209(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1102),
     *  C00067,C00068,C00242,C00243,C00245,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1104).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aAPEUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1104).NE.'n') then
      CALL S00210(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1104),
     *  C00064,C00069,C00241,C00242,C00244,C00246,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1106).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aAPEiiUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1106).NE.'n') then
      CALL S00211(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1106),
     *  C00244,C00246,C00247,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1107).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aAPEUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1107).NE.'n') then
      CALL S00212(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1107),
     *  C00246,C00247,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1109).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEYUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1109).NE.'n') then
      CALL S00213(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1109),
     *  C00244,C00245,C00248,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1111).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'aEPUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1111).NE.'n') then
      CALL S00214(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1111),
     *  C00244,C00246,C00248,C00249,
     *  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(1120).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'REGHCOUNT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1120).NE.'n') then
      CALL S00215(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1120),
     *  C00250,C00251,
     *  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
      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(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=36
       SSNO=39
       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,39,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=41
       SSNO=40
       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,40,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=42
       SSNO=41
       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,41,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=43
       SSNO=42
       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,42,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=44
       SSNO=43
       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,43,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=45
       SSNO=44
       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,44,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=46
       SSNO=45
       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,45,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
      RETURN
15000 CALL PERET('M00008')
      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(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=47
       SSNO=46
       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,46,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=48
       SSNO=47
       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,47,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=49
       SSNO=48
       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,48,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=50
       SSNO=49
       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,49,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=51
       SSNO=50
       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,50,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('M00009')
      RETURN
      END
      SUBROUTINE S00216(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00250,C00251,C00254,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      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 C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00251(SSZ(39),SSZ(40))
      REAL C00254(SSZ(39),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "POVSHR"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      NZDZ=0
      NNDZ=0
      DO 2 I00007=1,SSZ(37)
      DO 3 I00002=1,SSZ(40)
      DO 1 I00015=1,SSZ(39)
      RS1=C00250(I00015,I00002,I00007)
      RS2=C00251(I00015,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      C00254(I00015,I00007,I00002)=RS3
    1 CONTINUE
    3 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 "POVSHR"',
     *  ' ',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,
     *  C00252,C00255,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER 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 C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      REAL C00255(SSZ(39),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TOTPOVELAST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(40)
      DO 2 I00007=1,SSZ(37)
      DO 1 I00015=1,SSZ(39)
      RS1=0.0
      DO 4 I00001=1,SSZ(38)
      RS1=RS1+C00252(I00015,I00001,I00007,I00002)
    4 CONTINUE
      C00255(I00015,I00007,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 "TOTPOVELAST"',
     *  ' ',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,
     *  C00252,C00255,C00256,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      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 C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      REAL C00255(SSZ(39),SSZ(37),SSZ(40))
      REAL C00256(SSZ(39),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TAXPOVELAST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(40)
      DO 2 I00007=1,SSZ(37)
      DO 1 I00015=1,SSZ(39)
      C00256(I00015,I00007,I00002)=C00255(I00015,I00007,I00002)-
     *  C00252(I00015,SSMP(SSMPST(50)-1+1),I00007,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 "TAXPOVELAST"',
     *  ' ',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,
     *  C00254,C00255,C00257,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER 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 C00254(SSZ(39),SSZ(37),SSZ(40))
      REAL C00255(SSZ(39),SSZ(37),SSZ(40))
      REAL C00257(SSZ(39),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "NATLPOVELAST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(40)
      DO 1 I00015=1,SSZ(39)
      RS1=0.0
      DO 3 I00007=1,SSZ(37)
      RS1=RS1+C00254(I00015,I00007,I00002)*C00255(I00015,I00007,I00002)
    3 CONTINUE
      C00257(I00015,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 "NATLPOVELAST"',
     *  ' ',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,
     *  C00254,C00256,C00258,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER 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 C00254(SSZ(39),SSZ(37),SSZ(40))
      REAL C00256(SSZ(39),SSZ(37),SSZ(40))
      REAL C00258(SSZ(39),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "NATLTAXELAST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 2 I00002=1,SSZ(40)
      DO 1 I00015=1,SSZ(39)
      RS1=0.0
      DO 3 I00007=1,SSZ(37)
      RS1=RS1+C00254(I00015,I00007,I00002)*C00256(I00015,I00007,I00002)
    3 CONTINUE
      C00258(I00015,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 "NATLTAXELAST"',
     *  ' ',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,
     *  C00034,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 C00034(SSZ(5),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(5)
      RS1=RS1+C00034(I00001,I00002)
    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('S00221')
      RETURN
      END
      SUBROUTINE S00222(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00034,C00035,C00260,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00016
      INTEGER 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(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00260(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00016=1,SSZ(5)
      RS2=C00034(I00016,I00002)*C00034(I00001,I00002)
      RS3=C00035(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4
    3 CONTINUE
      C00260(I00001,I00002)=-C00034(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 "C00260"',
     *  ' ',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,
     *  C00034,C00035,C00261,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00016
      INTEGER 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(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00261(SSZ(5),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00016=1,SSZ(5)
      RS2=C00034(I00016,I00002)*C00034(I00001,I00002)
      RS3=C00035(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4
    3 CONTINUE
      C00261(I00001,I00002)=C00034(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 "C00261"',
     *  ' ',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,
     *  C00034,C00035,C00039,C00040,C00056,C00061,C00262,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00016
      INTEGER 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(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00039(SSZ(5),SSZ(1))
      REAL C00040(SSZ(5),SSZ(1))
      REAL C00056(SSZ(5))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00262(SSZ(5),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00016=1,SSZ(5)
      RS2=C00040(I00016,I00002)*C00034(I00001,I00002)
      RS3=C00035(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(1  -C00061(I00001,I00002))
    3 CONTINUE
      C00262(I00001,I00002)=-(C00039(I00001,I00002)+
     *  C00040(I00001,I00002)*(-1.0+C00056(I00001))*(1  -
     *  C00061(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 "C00262"',
     *  ' ',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,
     *  C00034,C00035,C00040,C00056,C00061,C00263,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00016
      INTEGER 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(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00040(SSZ(5),SSZ(1))
      REAL C00056(SSZ(5))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00263(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00016=1,SSZ(5)
      RS2=C00040(I00016,I00002)*C00034(I00001,I00002)
      RS3=C00035(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*C00061(I00001,I00002)
    3 CONTINUE
      C00263(I00001,I00002)=-C00040(I00001,I00002)*(1.0-(C00056(I00001)-
     *  (-1.0+C00056(I00001))*C00061(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('S00225')
      RETURN
      END
      SUBROUTINE S00226(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00040,C00264,
     *  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 C00040(SSZ(5),SSZ(1))
      REAL C00264(SSZ(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 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(5)
      RS1=RS1+C00040(I00001,I00002)
    2 CONTINUE
      C00264(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 "C00264"',
     *  ' ',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,
     *  C00097,C00265,
     *  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 C00097(SSZ(11),SSZ(10),SSZ(1))
      REAL C00265(SSZ(10),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(10)
      RS1=0.0
      DO 3 I00001=1,SSZ(9)
      RS1=RS1-C00097(SSMP(SSMPST(6)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00265(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 "C00265"',
     *  ' ',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,
     *  C00087,C00266,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00087(SSZ(5),SSZ(15),SSZ(1))
      REAL C00266(SSZ(22),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(22)
      RS1=0.0
      DO 3 I00007=1,SSZ(5)
      RS1=RS1-C00087(I00007,SSMP(SSMPST(21)-1+I00004),I00002)
    3 CONTINUE
      C00266(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 "C00266"',
     *  ' ',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,
     *  C00088,C00267,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      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 C00088(SSZ(5),SSZ(21),SSZ(1))
      REAL C00267(SSZ(21),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(21)
      RS1=0.0
      DO 3 I00005=1,SSZ(23)
      RS1=RS1+C00088(SSMP(SSMPST(22)-1+I00005),I00004,I00002)
    3 CONTINUE
      C00267(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 "C00267"',
     *  ' ',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,
     *  C00088,C00268,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00088(SSZ(5),SSZ(21),SSZ(1))
      REAL C00268(SSZ(21),SSZ(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 I00004=1,SSZ(21)
      RS1=0.0
      DO 3 I00007=1,SSZ(24)
      RS1=RS1-C00088(SSMP(SSMPST(23)-1+I00007),I00004,I00002)
    3 CONTINUE
      C00268(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 "C00268"',
     *  ' ',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,
     *  C00097,C00269,
     *  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 C00097(SSZ(11),SSZ(10),SSZ(1))
      REAL C00269(SSZ(10),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(10)
      RS1=0.0
      DO 3 I00001=1,SSZ(5)
      RS1=RS1+C00097(SSMP(SSMPST(7)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00269(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 "C00269"',
     *  ' ',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,
     *  C00030,C00034,C00061,C00096,C00270,
     *  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
      LOGICAL ECHO1
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00034(SSZ(5),SSZ(1))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00270(SSZ(5),SSZ(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 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1-C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)*(1  -
     *  C00096(I00001,I00004,I00003))
    3 CONTINUE
      C00270(I00001,I00003)=-C00034(I00001,I00003)*(1.0-1.0)*(1  -
     *  C00061(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 "C00270"',
     *  ' ',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,
     *  C00030,C00034,C00061,C00096,C00271,
     *  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
      LOGICAL ECHO1
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00034(SSZ(5),SSZ(1))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00271(SSZ(5),SSZ(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 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1-C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)*
     *  C00096(I00001,I00004,I00003)
    3 CONTINUE
      C00271(I00001,I00003)=-C00034(I00001,I00003)*(1.0-1.0)*
     *  C00061(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 "C00271"',
     *  ' ',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,
     *  C00030,C00034,C00061,C00096,C00272,
     *  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
      LOGICAL ECHO1
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00034(SSZ(5),SSZ(1))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00272(SSZ(5),SSZ(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 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1-C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)*(1  -
     *  C00096(I00001,I00004,I00003))
    3 CONTINUE
      C00272(I00001,I00003)=-C00034(I00001,I00003)*(1  -
     *  C00061(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 "C00272"',
     *  ' ',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,
     *  C00030,C00034,C00061,C00096,C00273,
     *  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
      LOGICAL ECHO1
      REAL C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00034(SSZ(5),SSZ(1))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00273(SSZ(5),SSZ(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 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1-C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)*
     *  C00096(I00001,I00004,I00003)
    3 CONTINUE
      C00273(I00001,I00003)=-C00034(I00001,I00003)*
     *  C00061(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 "C00273"',
     *  ' ',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,
     *  C00045,C00046,C00056,C00096,C00274,
     *  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 C00045(SSZ(5),SSZ(10),SSZ(1))
      REAL C00046(SSZ(5),SSZ(10),SSZ(1))
      REAL C00056(SSZ(5))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00274(SSZ(5),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1+C00045(I00001,I00004,I00002)
    3 CONTINUE
      RS2=0.0
      DO 4 I00004=1,SSZ(10)
      RS2=RS2+C00046(I00001,I00004,I00002)*C00056(I00001)*(1  -
     *  C00096(I00001,I00004,I00002))
    4 CONTINUE
      C00274(I00001,I00002)=-(RS1+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 "C00274"',
     *  ' ',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,
     *  C00046,C00056,C00096,C00275,
     *  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 C00046(SSZ(5),SSZ(10),SSZ(1))
      REAL C00056(SSZ(5))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00275(SSZ(5),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1+C00046(I00001,I00004,I00002)*(1.0-(C00056(I00001)-
     *  C00056(I00001)*C00096(I00001,I00004,I00002)))
    3 CONTINUE
      C00275(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 "C00275"',
     *  ' ',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,
     *  C00056,C00061,C00096,C00130,C00132,C00276,
     *  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 C00056(SSZ(5))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00130(SSZ(5),SSZ(10),SSZ(1))
      REAL C00132(SSZ(5),SSZ(1))
      REAL C00276(SSZ(5),SSZ(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 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1-C00130(I00001,I00004,I00002)*C00056(I00001)*(1  -
     *  C00096(I00001,I00004,I00002))
    3 CONTINUE
      C00276(I00001,I00002)=-C00132(I00001,I00002)*(-1.0+
     *  C00056(I00001))*(1  -C00061(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 "C00276"',
     *  ' ',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,
     *  C00056,C00061,C00096,C00130,C00131,C00132,C00277,
     *  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 C00056(SSZ(5))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00130(SSZ(5),SSZ(10),SSZ(1))
      REAL C00131(SSZ(5),SSZ(1))
      REAL C00132(SSZ(5),SSZ(1))
      REAL C00277(SSZ(5),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1+C00130(I00001,I00004,I00002)*(C00056(I00001)-
     *  C00056(I00001)*C00096(I00001,I00004,I00002))
    3 CONTINUE
      C00277(I00001,I00002)=C00132(I00001,I00002)*(C00056(I00001)-(-1.0+
     *  C00056(I00001))*C00061(I00001,I00002))+C00131(I00001,I00002)*
     *  C00056(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 "C00277"',
     *  ' ',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,
     *  C00094,C00278,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(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 I00004=1,SSZ(10)
      RS1=0.0
      DO 3 I00007=1,SSZ(9)
      RS1=RS1-C00094(I00007,I00004,I00002)
    3 CONTINUE
      C00278(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 "C00278"',
     *  ' ',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,
     *  C00097,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
      LOGICAL ECHO1
      REAL C00097(SSZ(11),SSZ(10),SSZ(1))
      REAL C00279(SSZ(10),SSZ(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 I00004=1,SSZ(10)
      RS1=0.0
      DO 3 I00001=1,SSZ(9)
      RS1=RS1+C00097(SSMP(SSMPST(6)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00279(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 "C00279"',
     *  ' ',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,
     *  C00048,C00086,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
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00280(SSZ(15),SSZ(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 I00004=1,SSZ(15)
      RS1=0.0
      DO 3 I00001=1,SSZ(28)
      RS1=RS1+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
    3 CONTINUE
      C00280(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 "C00280"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00242')
      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(1162).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'POVSHR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1162).NE.'n') then
      CALL S00216(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1162),
     *  C00250,C00251,C00254,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1176).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TOTPOVELAST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1176).NE.'n') then
      CALL S00217(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1176),
     *  C00252,C00255,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1178).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TAXPOVELAST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1178).NE.'n') then
      CALL S00218(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1178),
     *  C00252,C00255,C00256,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1188).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NATLPOVELAST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1188).NE.'n') then
      CALL S00219(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1188),
     *  C00254,C00255,C00257,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1190).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NATLTAXELAST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1190).NE.'n') then
      CALL S00220(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1190),
     *  C00254,C00256,C00258,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00009),C00009,
     *  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(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(C00098),C00098,
     *  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(C00105),C00105,
     *  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(1222).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00259',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1222).NE.'n') then
      CALL S00221(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1222),
     *  C00034,C00259,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1224).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00260',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1224).NE.'n') then
      CALL S00222(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1224),
     *  C00034,C00035,C00260,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1226).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00261',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1226).NE.'n') then
      CALL S00223(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1226),
     *  C00034,C00035,C00261,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1228).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00262',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1228).NE.'n') then
      CALL S00224(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1228),
     *  C00034,C00035,C00039,C00040,C00056,C00061,C00262,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1230).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00263',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1230).NE.'n') then
      CALL S00225(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1230),
     *  C00034,C00035,C00040,C00056,C00061,C00263,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1232).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00264',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1232).NE.'n') then
      CALL S00226(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1232),
     *  C00040,C00264,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1234).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00265',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1234).NE.'n') then
      CALL S00227(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1234),
     *  C00097,C00265,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1236).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00266',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1236).NE.'n') then
      CALL S00228(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1236),
     *  C00087,C00266,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1238).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00267',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1238).NE.'n') then
      CALL S00229(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1238),
     *  C00088,C00267,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1240).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00268',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1240).NE.'n') then
      CALL S00230(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1240),
     *  C00088,C00268,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1242).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00269',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1242).NE.'n') then
      CALL S00231(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1242),
     *  C00097,C00269,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1244).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00270',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1244).NE.'n') then
      CALL S00232(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1244),
     *  C00030,C00034,C00061,C00096,C00270,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1246).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00271',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1246).NE.'n') then
      CALL S00233(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1246),
     *  C00030,C00034,C00061,C00096,C00271,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1248).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00272',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1248).NE.'n') then
      CALL S00234(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1248),
     *  C00030,C00034,C00061,C00096,C00272,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1250).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00273',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1250).NE.'n') then
      CALL S00235(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1250),
     *  C00030,C00034,C00061,C00096,C00273,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1252).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00274',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1252).NE.'n') then
      CALL S00236(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1252),
     *  C00045,C00046,C00056,C00096,C00274,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1254).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00275',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1254).NE.'n') then
      CALL S00237(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1254),
     *  C00046,C00056,C00096,C00275,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1256).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00276',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1256).NE.'n') then
      CALL S00238(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1256),
     *  C00056,C00061,C00096,C00130,C00132,C00276,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1258).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00277',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1258).NE.'n') then
      CALL S00239(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1258),
     *  C00056,C00061,C00096,C00130,C00131,C00132,C00277,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1260).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00278',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1260).NE.'n') then
      CALL S00240(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1260),
     *  C00094,C00278,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1262).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00279',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1262).NE.'n') then
      CALL S00241(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1262),
     *  C00097,C00279,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1264).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00280',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1264).NE.'n') then
      CALL S00242(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1264),
     *  C00048,C00086,C00280,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00010')
      RETURN
      END
      SUBROUTINE S00243(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00086,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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00281(SSZ(16),SSZ(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 I00004=1,SSZ(16)
      RS1=0.0
      DO 3 I00001=1,SSZ(28)
      RS1=RS1+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*C00086(SSMP(SSMPST(13)-1+I00004),I00002)
    3 CONTINUE
      C00281(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 "C00281"',
     *  ' ',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,
     *  C00048,C00086,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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00282(SSZ(10),SSZ(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 I00004=1,SSZ(10)
      RS1=0.0
      DO 3 I00001=1,SSZ(27)
      RS1=RS1+C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*
     *  C00086(I00004,I00002)
    3 CONTINUE
      C00282(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 "C00282"',
     *  ' ',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,
     *  C00048,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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00283(SSZ(15),SSZ(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 I00004=1,SSZ(15)
      RS1=0.0
      DO 3 I00001=1,SSZ(28)
      RS1=RS1+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
    3 CONTINUE
      C00283(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 "C00283"',
     *  ' ',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,
     *  C00048,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
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00284(SSZ(16),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(16)
      RS1=0.0
      DO 3 I00001=1,SSZ(28)
      RS1=RS1+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)
    3 CONTINUE
      C00284(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 "C00284"',
     *  ' ',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,
     *  C00048,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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00285(SSZ(10),SSZ(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 I00004=1,SSZ(10)
      RS1=0.0
      DO 3 I00001=1,SSZ(27)
      RS1=RS1+C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)
    3 CONTINUE
      C00285(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 "C00285"',
     *  ' ',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,
     *  C00048,C00086,C00094,C00095,C00286,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00286(SSZ(9),SSZ(15),SSZ(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 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(15)
      DO 1 I00007=1,SSZ(9)
      RS1=0.0
      DO 4 I00001=1,SSZ(28)
      RS1=RS1+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    4 CONTINUE
      C00286(I00007,I00004,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 "C00286"',
     *  ' ',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,
     *  C00048,C00086,C00094,C00095,C00287,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00287(SSZ(9),SSZ(16),SSZ(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 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(16)
      DO 1 I00007=1,SSZ(9)
      RS1=0.0
      DO 4 I00001=1,SSZ(28)
      RS1=RS1+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-C00086(SSMP(SSMPST(13)-1+I00004),I00002)+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002))*
     *  C00094(I00007,SSMP(SSMPST(13)-1+I00004),I00002)
    4 CONTINUE
      C00287(I00007,I00004,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 "C00287"',
     *  ' ',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,
     *  C00048,C00086,C00094,C00095,C00288,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00288(SSZ(9),SSZ(10),SSZ(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 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(10)
      DO 1 I00007=1,SSZ(9)
      RS1=0.0
      DO 4 I00001=1,SSZ(27)
      RS1=RS1+C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*(-
     *  C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00094(I00007,I00004,I00002)
    4 CONTINUE
      C00288(I00007,I00004,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 "C00288"',
     *  ' ',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,
     *  C00048,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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00289(SSZ(28),SSZ(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(28)
      RS1=0.0
      DO 3 I00004=1,SSZ(15)
      RS1=RS1+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
    3 CONTINUE
      C00289(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('S00251')
      RETURN
      END
      SUBROUTINE S00252(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00290(SSZ(28),SSZ(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(28)
      RS1=0.0
      DO 3 I00004=1,SSZ(16)
      RS1=RS1+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)
    3 CONTINUE
      C00290(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 "C00290"',
     *  ' ',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,
     *  C00048,C00086,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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00291(SSZ(15),SSZ(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 I00004=1,SSZ(15)
      RS1=0.0
      DO 3 I00001=1,SSZ(28)
      RS1=RS1+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00086(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
    3 CONTINUE
      C00291(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 "C00291"',
     *  ' ',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,
     *  C00048,C00086,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
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00292(SSZ(16),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(16)
      RS1=0.0
      DO 3 I00001=1,SSZ(28)
      RS1=RS1+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-1.0+C00086(SSMP(SSMPST(13)-1+I00004),I00002))
    3 CONTINUE
      C00292(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 "C00292"',
     *  ' ',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,
     *  C00048,C00086,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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00293(SSZ(10),SSZ(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 I00004=1,SSZ(10)
      RS1=0.0
      DO 3 I00001=1,SSZ(27)
      RS1=RS1+C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*(-1.0+
     *  C00086(I00004,I00002))
    3 CONTINUE
      C00293(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 "C00293"',
     *  ' ',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,
     *  C00048,C00086,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,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),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(15)
      RS2=0.0
      DO 2 I00001=1,SSZ(28)
      RS2=RS2+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00086(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      RS3=0.0
      DO 5 I00004=1,SSZ(16)
      RS4=0.0
      DO 4 I00001=1,SSZ(28)
      RS4=RS4+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-1.0+C00086(SSMP(SSMPST(13)-1+I00004),I00002))
    4 CONTINUE
      RS3=RS3+RS4
    5 CONTINUE
      RS5=0.0
      DO 7 I00004=1,SSZ(10)
      RS6=0.0
      DO 6 I00001=1,SSZ(27)
      RS6=RS6+C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*(-1.0+
     *  C00086(I00004,I00002))
    6 CONTINUE
      RS5=RS5+RS6
    7 CONTINUE
      C00294(I00002)=-(RS1+RS3+RS5)
    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('S00256')
      RETURN
      END
      SUBROUTINE S00257(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00086,C00094,C00095,C00295,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00295(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 "C00295"',
     *  ' ',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(9)
      RS1=0.0
      DO 4 I00004=1,SSZ(15)
      RS2=0.0
      DO 3 I00001=1,SSZ(28)
      RS2=RS2-C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      RS3=0.0
      DO 6 I00004=1,SSZ(16)
      RS4=0.0
      DO 5 I00001=1,SSZ(28)
      RS4=RS4-C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-C00086(SSMP(SSMPST(13)-1+I00004),I00002)+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002))*
     *  C00094(I00007,SSMP(SSMPST(13)-1+I00004),I00002)
    5 CONTINUE
      RS3=RS3+RS4
    6 CONTINUE
      RS5=0.0
      DO 8 I00004=1,SSZ(10)
      RS6=0.0
      DO 7 I00001=1,SSZ(27)
      RS6=RS6-C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*(-
     *  C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00094(I00007,I00004,I00002)
    7 CONTINUE
      RS5=RS5+RS6
    8 CONTINUE
      C00295(I00007,I00002)=-(RS1+RS3+RS5)
    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 "C00295"',
     *  ' ',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,
     *  C00048,C00095,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,RS2
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00296(SSZ(28),SSZ(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(28)
      RS1=0.0
      DO 3 I00004=1,SSZ(15)
      RS1=RS1+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
    3 CONTINUE
      RS2=0.0
      DO 4 I00004=1,SSZ(16)
      RS2=RS2+C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-1.0+C00095(SSMP(SSMPST(13)-1+I00004),I00002))
    4 CONTINUE
      C00296(I00001,I00002)=-(RS1+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 "C00296"',
     *  ' ',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,
     *  C00048,C00095,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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00297(SSZ(27),SSZ(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(27)
      RS1=0.0
      DO 3 I00004=1,SSZ(10)
      RS1=RS1+C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*(-1.0+
     *  C00095(I00004,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('S00259')
      RETURN
      END
      SUBROUTINE S00260(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00086,C00095,C00278,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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      REAL C00298(SSZ(15),SSZ(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 I00004=1,SSZ(15)
      RS1=0.0
      DO 3 I00001=1,SSZ(28)
      RS1=RS1-C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*((-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*C00278(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)-(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002)))
    3 CONTINUE
      C00298(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 "C00298"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00260')
      RETURN
      END
      SUBROUTINE S00261(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00086,C00095,C00278,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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      REAL C00299(SSZ(16),SSZ(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 I00004=1,SSZ(16)
      RS1=0.0
      DO 3 I00001=1,SSZ(28)
      RS1=RS1-C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*((-C00086(SSMP(SSMPST(13)-1+I00004),I00002)+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002))*
     *  C00278(SSMP(SSMPST(13)-1+I00004),I00002)-(-1.0+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002)))
    3 CONTINUE
      C00299(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 "C00299"',
     *  ' ',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,
     *  C00048,C00086,C00095,C00278,C00300,
     *  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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      REAL C00300(SSZ(10),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(10)
      RS1=0.0
      DO 3 I00001=1,SSZ(27)
      RS1=RS1-C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*((-
     *  C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00278(I00004,I00002)-(-1.0+C00095(I00004,I00002)))
    3 CONTINUE
      C00300(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 "C00300"',
     *  ' ',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,
     *  C00048,C00086,C00095,C00278,C00301,
     *  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,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),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 3 I00004=1,SSZ(15)
      RS2=0.0
      DO 2 I00001=1,SSZ(28)
      RS2=RS2-C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*((-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*C00278(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)-(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002)))
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      RS3=0.0
      DO 5 I00004=1,SSZ(16)
      RS4=0.0
      DO 4 I00001=1,SSZ(28)
      RS4=RS4-C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*((-C00086(SSMP(SSMPST(13)-1+I00004),I00002)+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002))*
     *  C00278(SSMP(SSMPST(13)-1+I00004),I00002)-(-1.0+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002)))
    4 CONTINUE
      RS3=RS3+RS4
    5 CONTINUE
      RS5=0.0
      DO 7 I00004=1,SSZ(10)
      RS6=0.0
      DO 6 I00001=1,SSZ(27)
      RS6=RS6-C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*((-
     *  C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00278(I00004,I00002)-(-1.0+C00095(I00004,I00002)))
    6 CONTINUE
      RS5=RS5+RS6
    7 CONTINUE
      C00301(I00002)=-(RS1+RS3+RS5)
    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('S00263')
      RETURN
      END
      SUBROUTINE S00264(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00048,C00086,C00094,C00095,C00302,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00302(SSZ(9),SSZ(15),SSZ(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 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(15)
      DO 1 I00007=1,SSZ(9)
      RS1=0.0
      DO 4 I00001=1,SSZ(28)
      RS1=RS1-C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    4 CONTINUE
      C00302(I00007,I00004,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 "C00302"',
     *  ' ',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,
     *  C00048,C00086,C00094,C00095,C00303,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00303(SSZ(9),SSZ(16),SSZ(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 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(16)
      DO 1 I00007=1,SSZ(9)
      RS1=0.0
      DO 4 I00001=1,SSZ(28)
      RS1=RS1-C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-C00086(SSMP(SSMPST(13)-1+I00004),I00002)+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002))*
     *  C00094(I00007,SSMP(SSMPST(13)-1+I00004),I00002)
    4 CONTINUE
      C00303(I00007,I00004,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 "C00303"',
     *  ' ',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,
     *  C00048,C00086,C00094,C00095,C00304,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00304(SSZ(9),SSZ(10),SSZ(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 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(10)
      DO 1 I00007=1,SSZ(9)
      RS1=0.0
      DO 4 I00001=1,SSZ(27)
      RS1=RS1-C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*(-
     *  C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00094(I00007,I00004,I00002)
    4 CONTINUE
      C00304(I00007,I00004,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 "C00304"',
     *  ' ',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,
     *  C00021,C00086,C00305,
     *  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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00305(SSZ(28),SSZ(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 I00001=1,SSZ(28)
      RS1=0.0
      DO 3 I00004=1,SSZ(15)
      RS1=RS1+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00086(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
    3 CONTINUE
      C00305(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 "C00305"',
     *  ' ',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,
     *  C00021,C00086,C00094,C00095,C00306,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00306(SSZ(28),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 "C00306"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00007=1,SSZ(9)
      DO 1 I00001=1,SSZ(28)
      RS1=0.0
      DO 4 I00004=1,SSZ(15)
      RS1=RS1-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    4 CONTINUE
      C00306(I00001,I00007,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 "C00306"',
     *  ' ',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,
     *  C00021,C00095,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00307(SSZ(28),SSZ(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 I00001=1,SSZ(28)
      RS1=0.0
      DO 3 I00004=1,SSZ(15)
      RS1=RS1+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
    3 CONTINUE
      C00307(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 "C00307"',
     *  ' ',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,
     *  C00021,C00086,C00095,C00278,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      REAL C00308(SSZ(28),SSZ(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(28)
      RS1=0.0
      DO 3 I00004=1,SSZ(15)
      RS1=RS1-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*((-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*C00278(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)-(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+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('S00270')
      RETURN
      END
      SUBROUTINE S00271(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00086,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00309(SSZ(28),SSZ(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 I00001=1,SSZ(28)
      RS1=0.0
      DO 3 I00004=1,SSZ(16)
      RS1=RS1+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-1.0+C00086(SSMP(SSMPST(13)-1+I00004),I00002))
    3 CONTINUE
      C00309(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 "C00309"',
     *  ' ',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,
     *  C00021,C00086,C00094,C00095,C00310,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00310(SSZ(28),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 "C00310"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(1)
      DO 2 I00007=1,SSZ(9)
      DO 1 I00001=1,SSZ(28)
      RS1=0.0
      DO 4 I00004=1,SSZ(16)
      RS1=RS1-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-C00086(SSMP(SSMPST(13)-1+I00004),I00002)+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002))*
     *  C00094(I00007,SSMP(SSMPST(13)-1+I00004),I00002)
    4 CONTINUE
      C00310(I00001,I00007,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 "C00310"',
     *  ' ',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,
     *  C00021,C00095,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00311(SSZ(28),SSZ(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(28)
      RS1=0.0
      DO 3 I00004=1,SSZ(16)
      RS1=RS1+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-1.0+C00095(SSMP(SSMPST(13)-1+I00004),I00002))
    3 CONTINUE
      C00311(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 "C00311"',
     *  ' ',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,
     *  C00021,C00086,C00095,C00278,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      REAL C00312(SSZ(28),SSZ(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 I00001=1,SSZ(28)
      RS1=0.0
      DO 3 I00004=1,SSZ(16)
      RS1=RS1-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*((-C00086(SSMP(SSMPST(13)-1+I00004),I00002)+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002))*
     *  C00278(SSMP(SSMPST(13)-1+I00004),I00002)-(-1.0+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002)))
    3 CONTINUE
      C00312(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 "C00312"',
     *  ' ',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,
     *  C00021,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
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00313(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 "C00313"',
     *  ' ',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(15)
      RS1=RS1+C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)
    3 CONTINUE
      C00313(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 "C00313"',
     *  ' ',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,
     *  C00021,C00086,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,RS2
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00314(SSZ(15),SSZ(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 I00004=1,SSZ(15)
      RS1=0.0
      DO 3 I00001=1,SSZ(13)
      RS1=RS1+C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)
    3 CONTINUE
      RS2=0.0
      DO 4 I00001=1,SSZ(28)
      RS2=RS2+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
    4 CONTINUE
      C00314(I00004,I00002)=-(RS1+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 "C00314"',
     *  ' ',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,
     *  C00021,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00315(SSZ(15),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(15)
      RS1=0.0
      DO 3 I00001=1,SSZ(13)
      RS1=RS1+C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)
    3 CONTINUE
      RS2=0.0
      DO 4 I00001=1,SSZ(28)
      RS2=RS2+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
    4 CONTINUE
      C00315(I00004,I00002)=-(RS1+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 "C00315"',
     *  ' ',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,
     *  C00021,C00086,C00094,C00095,C00316,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00316(SSZ(9),SSZ(15),SSZ(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 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(15)
      DO 1 I00007=1,SSZ(9)
      RS1=0.0
      DO 4 I00001=1,SSZ(13)
      RS1=RS1+C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*(-
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)+
     *  C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    4 CONTINUE
      RS2=0.0
      DO 5 I00001=1,SSZ(28)
      RS2=RS2+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    5 CONTINUE
      C00316(I00007,I00004,I00002)=-(RS1+RS2)
    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 "C00316"',
     *  ' ',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,
     *  C00021,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00317(SSZ(28),SSZ(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(28)
      RS1=0.0
      DO 3 I00004=1,SSZ(15)
      RS1=RS1+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
    3 CONTINUE
      C00317(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('S00279')
      RETURN
      END
      SUBROUTINE S00280(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00086,C00318,
     *  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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00318(SSZ(15),SSZ(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 I00004=1,SSZ(15)
      RS1=0.0
      DO 3 I00001=1,SSZ(13)
      RS1=RS1+C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*(-
     *  1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002))
    3 CONTINUE
      RS2=0.0
      DO 4 I00001=1,SSZ(28)
      RS2=RS2+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00086(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
    4 CONTINUE
      C00318(I00004,I00002)=-(RS1+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 "C00318"',
     *  ' ',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,
     *  C00021,C00086,C00319,
     *  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,RS3,RS4
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00319(SSZ(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 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00004=1,SSZ(15)
      RS2=0.0
      DO 2 I00001=1,SSZ(13)
      RS2=RS2+C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*(-
     *  1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002))
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      RS3=0.0
      DO 5 I00004=1,SSZ(15)
      RS4=0.0
      DO 4 I00001=1,SSZ(28)
      RS4=RS4+C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00086(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
    4 CONTINUE
      RS3=RS3+RS4
    5 CONTINUE
      C00319(I00002)=-(RS1+RS3)
    1 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('S00281')
      RETURN
      END
      SUBROUTINE S00282(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00086,C00094,C00095,C00320,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00320(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 "C00320"',
     *  ' ',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(9)
      RS1=0.0
      DO 4 I00004=1,SSZ(15)
      RS2=0.0
      DO 3 I00001=1,SSZ(13)
      RS2=RS2-C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*(-
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)+
     *  C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      RS3=0.0
      DO 6 I00004=1,SSZ(15)
      RS4=0.0
      DO 5 I00001=1,SSZ(28)
      RS4=RS4-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    5 CONTINUE
      RS3=RS3+RS4
    6 CONTINUE
      C00320(I00007,I00002)=-(RS1+RS3)
    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('S00282')
      RETURN
      END
      SUBROUTINE S00283(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00095,C00321,
     *  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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00321(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 "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(13)
      RS1=0.0
      DO 3 I00004=1,SSZ(15)
      RS1=RS1+C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*(-
     *  1.0+C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002))
    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('S00283')
      RETURN
      END
      SUBROUTINE S00284(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00086,C00095,C00278,C00322,
     *  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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      REAL C00322(SSZ(15),SSZ(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 I00004=1,SSZ(15)
      RS1=0.0
      DO 3 I00001=1,SSZ(13)
      RS1=RS1-C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*((-
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)+
     *  C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00278(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)-(-
     *  1.0+C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)))
    3 CONTINUE
      RS2=0.0
      DO 4 I00001=1,SSZ(28)
      RS2=RS2-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*((-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*C00278(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)-(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002)))
    4 CONTINUE
      C00322(I00004,I00002)=-(RS1+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 "C00322"',
     *  ' ',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,
     *  C00021,C00086,C00095,C00278,C00323,
     *  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,RS3,RS4
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      REAL C00323(SSZ(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 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00004=1,SSZ(15)
      RS2=0.0
      DO 2 I00001=1,SSZ(13)
      RS2=RS2-C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*((-
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)+
     *  C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00278(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)-(-
     *  1.0+C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)))
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      RS3=0.0
      DO 5 I00004=1,SSZ(15)
      RS4=0.0
      DO 4 I00001=1,SSZ(28)
      RS4=RS4-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*((-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*C00278(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)-(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002)))
    4 CONTINUE
      RS3=RS3+RS4
    5 CONTINUE
      C00323(I00002)=-(RS1+RS3)
    1 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('S00285')
      RETURN
      END
      SUBROUTINE S00286(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00021,C00086,C00094,C00095,C00324,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      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)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00324(SSZ(9),SSZ(15),SSZ(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 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(15)
      DO 1 I00007=1,SSZ(9)
      RS1=0.0
      DO 4 I00001=1,SSZ(13)
      RS1=RS1-C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*(-
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)+
     *  C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    4 CONTINUE
      RS2=0.0
      DO 5 I00001=1,SSZ(28)
      RS2=RS2-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
    5 CONTINUE
      C00324(I00007,I00004,I00002)=-(RS1+RS2)
    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 "C00324"',
     *  ' ',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,
     *  C00086,C00199,C00325,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00012
      INTEGER 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 C00086(SSZ(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL C00325(SSZ(4),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 "C00325"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 4 I00012=1,SSZ(15)
      RS1=RS1+C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*
     *  (-1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002)))
    4 CONTINUE
      C00325(I00001,I00004,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 "C00325"',
     *  ' ',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,
     *  C00095,C00199,C00326,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00012
      INTEGER 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 C00095(SSZ(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL C00326(SSZ(4),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 "C00326"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 4 I00012=1,SSZ(15)
      RS1=RS1+C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*
     *  (-1.0+C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002)))
    4 CONTINUE
      C00326(I00001,I00004,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 "C00326"',
     *  ' ',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,
     *  C00086,C00095,C00199,C00278,C00327,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00012
      INTEGER 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 C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL C00278(SSZ(10),SSZ(1))
      REAL C00327(SSZ(4),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 "C00327"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') RETURN
      DO 3 I00002=1,SSZ(2)
      DO 2 I00004=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      RS1=0.0
      DO 4 I00012=1,SSZ(15)
      RS1=RS1-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*
     *  ((-C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002)))*
     *  C00278(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))-(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002))))
    4 CONTINUE
      C00327(I00001,I00004,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 "C00327"',
     *  ' ',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,
     *  C00052,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 C00052(SSZ(5),SSZ(1),SSZ(1))
      REAL C00328(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00052(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('S00290')
      RETURN
      END
      SUBROUTINE S00291(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00028,C00052,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 C00028(SSZ(5),SSZ(1),SSZ(1))
      REAL C00052(SSZ(5),SSZ(1),SSZ(1))
      REAL C00329(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00028(I00001,I00002,I00003)-C00052(I00001,I00002,I00003)
    3 CONTINUE
      C00329(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('S00291')
      RETURN
      END
      SUBROUTINE S00292(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00330(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00027(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('S00292')
      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(1266).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00281',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1266).NE.'n') then
      CALL S00243(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1266),
     *  C00048,C00086,C00281,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1268).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00282',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1268).NE.'n') then
      CALL S00244(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1268),
     *  C00048,C00086,C00282,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1270).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00283',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1270).NE.'n') then
      CALL S00245(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1270),
     *  C00048,C00283,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1272).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00284',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1272).NE.'n') then
      CALL S00246(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1272),
     *  C00048,C00284,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1274).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00285',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1274).NE.'n') then
      CALL S00247(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1274),
     *  C00048,C00285,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1276).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00286',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1276).NE.'n') then
      CALL S00248(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1276),
     *  C00048,C00086,C00094,C00095,C00286,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1278).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00287',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1278).NE.'n') then
      CALL S00249(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1278),
     *  C00048,C00086,C00094,C00095,C00287,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1280).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00288',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1280).NE.'n') then
      CALL S00250(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1280),
     *  C00048,C00086,C00094,C00095,C00288,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1282).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00289',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1282).NE.'n') then
      CALL S00251(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1282),
     *  C00048,C00289,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1284).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00290',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1284).NE.'n') then
      CALL S00252(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1284),
     *  C00048,C00290,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1286).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00291',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1286).NE.'n') then
      CALL S00253(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1286),
     *  C00048,C00086,C00291,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1288).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00292',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1288).NE.'n') then
      CALL S00254(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1288),
     *  C00048,C00086,C00292,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1290).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00293',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1290).NE.'n') then
      CALL S00255(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1290),
     *  C00048,C00086,C00293,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1292).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00294',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1292).NE.'n') then
      CALL S00256(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1292),
     *  C00048,C00086,C00294,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1294).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00295',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1294).NE.'n') then
      CALL S00257(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1294),
     *  C00048,C00086,C00094,C00095,C00295,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1296).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00296',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1296).NE.'n') then
      CALL S00258(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1296),
     *  C00048,C00095,C00296,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1298).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00297',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1298).NE.'n') then
      CALL S00259(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1298),
     *  C00048,C00095,C00297,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1300).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00298',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1300).NE.'n') then
      CALL S00260(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1300),
     *  C00048,C00086,C00095,C00278,C00298,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1302).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00299',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1302).NE.'n') then
      CALL S00261(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1302),
     *  C00048,C00086,C00095,C00278,C00299,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1304).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00300',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1304).NE.'n') then
      CALL S00262(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1304),
     *  C00048,C00086,C00095,C00278,C00300,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1306).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00301',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1306).NE.'n') then
      CALL S00263(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1306),
     *  C00048,C00086,C00095,C00278,C00301,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1308).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00302',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1308).NE.'n') then
      CALL S00264(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1308),
     *  C00048,C00086,C00094,C00095,C00302,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1310).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00303',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1310).NE.'n') then
      CALL S00265(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1310),
     *  C00048,C00086,C00094,C00095,C00303,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1312).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00304',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1312).NE.'n') then
      CALL S00266(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1312),
     *  C00048,C00086,C00094,C00095,C00304,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1314).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00305',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1314).NE.'n') then
      CALL S00267(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1314),
     *  C00021,C00086,C00305,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1316).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00306',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1316).NE.'n') then
      CALL S00268(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1316),
     *  C00021,C00086,C00094,C00095,C00306,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1318).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00307',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1318).NE.'n') then
      CALL S00269(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1318),
     *  C00021,C00095,C00307,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1320).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00308',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1320).NE.'n') then
      CALL S00270(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1320),
     *  C00021,C00086,C00095,C00278,C00308,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1322).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00309',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1322).NE.'n') then
      CALL S00271(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1322),
     *  C00021,C00086,C00309,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1324).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00310',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1324).NE.'n') then
      CALL S00272(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1324),
     *  C00021,C00086,C00094,C00095,C00310,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1326).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00311',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1326).NE.'n') then
      CALL S00273(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1326),
     *  C00021,C00095,C00311,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1328).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00312',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1328).NE.'n') then
      CALL S00274(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1328),
     *  C00021,C00086,C00095,C00278,C00312,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1330).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00313',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1330).NE.'n') then
      CALL S00275(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1330),
     *  C00021,C00313,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1332).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00314',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1332).NE.'n') then
      CALL S00276(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1332),
     *  C00021,C00086,C00314,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1334).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00315',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1334).NE.'n') then
      CALL S00277(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1334),
     *  C00021,C00315,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1336).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00316',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1336).NE.'n') then
      CALL S00278(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1336),
     *  C00021,C00086,C00094,C00095,C00316,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1338).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00317',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1338).NE.'n') then
      CALL S00279(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1338),
     *  C00021,C00317,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1340).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00318',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1340).NE.'n') then
      CALL S00280(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1340),
     *  C00021,C00086,C00318,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1342).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00319',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1342).NE.'n') then
      CALL S00281(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1342),
     *  C00021,C00086,C00319,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1344).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00320',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1344).NE.'n') then
      CALL S00282(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1344),
     *  C00021,C00086,C00094,C00095,C00320,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1346).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00321',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1346).NE.'n') then
      CALL S00283(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1346),
     *  C00021,C00095,C00321,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1348).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00322',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1348).NE.'n') then
      CALL S00284(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1348),
     *  C00021,C00086,C00095,C00278,C00322,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1350).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00323',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1350).NE.'n') then
      CALL S00285(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1350),
     *  C00021,C00086,C00095,C00278,C00323,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1352).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00324',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1352).NE.'n') then
      CALL S00286(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1352),
     *  C00021,C00086,C00094,C00095,C00324,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1354).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00325',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1354).NE.'n') then
      CALL S00287(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1354),
     *  C00086,C00199,C00325,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1356).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00326',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1356).NE.'n') then
      CALL S00288(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1356),
     *  C00095,C00199,C00326,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1358).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00327',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1358).NE.'n') then
      CALL S00289(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1358),
     *  C00086,C00095,C00199,C00278,C00327,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1360).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00328',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1360).NE.'n') then
      CALL S00290(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1360),
     *  C00052,C00328,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1362).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00329',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1362).NE.'n') then
      CALL S00291(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1362),
     *  C00028,C00052,C00329,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1364).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00330',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1364).NE.'n') then
      CALL S00292(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1364),
     *  C00027,C00330,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00011')
      RETURN
      END
      SUBROUTINE S00293(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00331(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00027(I00001,I00002,I00003)
    3 CONTINUE
      C00331(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 "C00331"',
     *  ' ',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,
     *  C00027,C00061,C00260,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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00260(SSZ(5),SSZ(1))
      REAL C00332(SSZ(5),SSZ(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(5)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00027(I00001,I00002,I00003)
    3 CONTINUE
      C00332(I00001,I00002)=C00260(I00001,I00002)*(1  -
     *  C00061(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 "C00332"',
     *  ' ',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,
     *  C00027,C00333,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00333(SSZ(5),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00027(I00001,I00002,I00003)
    3 CONTINUE
      C00333(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 "C00333"',
     *  ' ',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,
     *  C00027,C00034,C00061,C00334,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00034(SSZ(5),SSZ(1))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00334(SSZ(5),SSZ(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 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00027(I00001,I00002,I00003)
    3 CONTINUE
      C00334(I00001,I00002)=-C00034(I00001,I00002)*(1  -
     *  C00061(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 "C00334"',
     *  ' ',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,
     *  C00027,C00029,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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00335(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 "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(6)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00335(I00005,I00002)=-(RS1+C00029(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 "C00335"',
     *  ' ',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,
     *  C00027,C00336,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00336(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 "C00336"',
     *  ' ',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(6)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00336(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 "C00336"',
     *  ' ',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,
     *  C00027,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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00337(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 "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(7)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00027(SSMP(SSMPST(3)-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('S00299')
      RETURN
      END
      SUBROUTINE S00300(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00027,C00338,
     *  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 C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00338(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 "C00338"',
     *  ' ',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 I00003=1,SSZ(1)
      RS1=RS1-C00027(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00338(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 "C00338"',
     *  ' ',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,
     *  C00156,C00157,C00339,
     *  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 C00156(SSZ(5),SSZ(1),SSZ(1))
      REAL C00157(SSZ(6),SSZ(1))
      REAL C00339(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 "C00339"',
     *  ' ',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(6)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00156(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00339(I00005,I00002)=-(RS1+C00157(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 "C00339"',
     *  ' ',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,
     *  C00156,C00340,
     *  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 C00156(SSZ(5),SSZ(1),SSZ(1))
      REAL C00340(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 "C00340"',
     *  ' ',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(6)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00156(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
    3 CONTINUE
      C00340(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 "C00340"',
     *  ' ',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,
     *  C00156,C00341,
     *  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 C00156(SSZ(5),SSZ(1),SSZ(1))
      REAL C00341(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 "C00341"',
     *  ' ',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 I00003=1,SSZ(1)
      RS1=RS1+C00156(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00341(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 "C00341"',
     *  ' ',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,
     *  C00156,C00342,
     *  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 C00156(SSZ(5),SSZ(1),SSZ(1))
      REAL C00342(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 "C00342"',
     *  ' ',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 I00003=1,SSZ(1)
      RS1=RS1-C00156(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
    3 CONTINUE
      C00342(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 "C00342"',
     *  ' ',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,
     *  C00103,C00343,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00103(SSZ(5),SSZ(1),SSZ(1))
      REAL C00343(SSZ(5),SSZ(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 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00007=1,SSZ(1)
      RS1=RS1+C00103(I00001,I00007,I00003)
    3 CONTINUE
      C00343(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 "C00343"',
     *  ' ',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,
     *  C00111,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,RS3
      LOGICAL ECHO1
      REAL C00111(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00344(SSZ(6))
      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 1 I00005=1,SSZ(6)
      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(5)
      RS3=RS3+C00111(I00005,I00001,I00002,I00003)
    2 CONTINUE
      RS2=RS2+RS3
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00344(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 "C00344"',
     *  ' ',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,
     *  C00111,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 C00111(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00345(SSZ(6),SSZ(5))
      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 I00001=1,SSZ(5)
      DO 1 I00005=1,SSZ(6)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00002=1,SSZ(1)
      RS2=RS2+C00111(I00005,I00001,I00002,I00003)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00345(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 "C00345"',
     *  ' ',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,
     *  C00111,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 C00111(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00346(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 "C00346"',
     *  ' ',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(6)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(5)
      RS2=RS2+C00111(I00005,I00001,I00002,I00003)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00346(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 "C00346"',
     *  ' ',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,
     *  C00111,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
      LOGICAL ECHO1
      REAL C00111(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00347(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 "C00347"',
     *  ' ',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(6)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(5)
      RS2=RS2+C00111(I00005,I00001,I00002,I00003)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00347(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 "C00347"',
     *  ' ',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,
     *  C00114,C00117,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
      LOGICAL ECHO1
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),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 "C00348"',
     *  ' ',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(5)
      RS1=0.0
      DO 4 I00005=1,SSZ(6)
      RS1=RS1+C00117(I00001,I00002,I00003)*
     *  C00114(I00005,I00001,I00002,I00003)
    4 CONTINUE
      C00348(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 "C00348"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00310')
      RETURN
      END
      SUBROUTINE S00311(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00103,C00114,C00117,C00349,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00103(SSZ(5),SSZ(1),SSZ(1))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00349(SSZ(6),SSZ(5),SSZ(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 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(5)
      DO 1 I00005=1,SSZ(6)
      RS1=0.0
      DO 4 I00007=1,SSZ(1)
      RS1=RS1+C00103(I00001,I00007,I00003)*C00117(I00001,I00007,I00003)*
     *  C00114(I00005,I00001,I00007,I00003)
    4 CONTINUE
      C00349(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 "C00349"',
     *  ' ',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,
     *  C00103,C00348,C00350,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00103(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL C00350(SSZ(5),SSZ(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 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00007=1,SSZ(1)
      RS1=RS1+C00103(I00001,I00007,I00003)*C00348(I00001,I00007,I00003)
    3 CONTINUE
      C00350(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 "C00350"',
     *  ' ',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,
     *  C00103,C00114,C00117,C00351,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00103(SSZ(5),SSZ(1),SSZ(1))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00351(SSZ(6),SSZ(5),SSZ(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 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(5)
      DO 1 I00005=1,SSZ(6)
      RS1=0.0
      DO 4 I00007=1,SSZ(1)
      RS1=RS1-C00103(I00001,I00007,I00003)*C00117(I00001,I00007,I00003)*
     *  C00114(I00005,I00001,I00007,I00003)
    4 CONTINUE
      C00351(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 "C00351"',
     *  ' ',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,
     *  C00025,C00352,
     *  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 C00025(SSZ(5),SSZ(1),SSZ(1))
      REAL C00352(SSZ(5),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1+C00025(I00001,I00003,I00002)
    3 CONTINUE
      C00352(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 "C00352"',
     *  ' ',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,
     *  C00054,C00114,C00117,C00353,
     *  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 C00054(SSZ(5),SSZ(1),SSZ(1))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00353(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 "C00353"',
     *  ' ',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(6)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(5)
      RS2=RS2-C00054(I00001,I00003,I00002)*C00117(I00001,I00003,I00002)*
     *  C00114(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00353(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 "C00353"',
     *  ' ',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,
     *  C00054,C00348,C00354,
     *  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 C00054(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL C00354(SSZ(5),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00054(I00001,I00003,I00002)*C00348(I00001,I00003,I00002)
    3 CONTINUE
      C00354(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 "C00354"',
     *  ' ',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,
     *  C00054,C00348,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 C00054(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL C00355(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 "C00355"',
     *  ' ',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(5)
      RS1=RS1-C00054(I00001,I00003,I00002)*C00348(I00001,I00003,I00002)
    3 CONTINUE
      C00355(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 "C00355"',
     *  ' ',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,
     *  C00054,C00348,C00356,
     *  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 C00054(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL C00356(SSZ(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 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(5)
      RS2=RS2-C00054(I00001,I00003,I00002)*C00348(I00001,I00003,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00356(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 "C00356"',
     *  ' ',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,
     *  C00054,C00114,C00117,C00357,
     *  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 C00054(SSZ(5),SSZ(1),SSZ(1))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00357(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 "C00357"',
     *  ' ',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(6)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(5)
      RS2=RS2+C00054(I00001,I00003,I00002)*C00117(I00001,I00003,I00002)*
     *  C00114(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00357(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 "C00357"',
     *  ' ',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,
     *  C00026,C00114,C00117,C00358,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      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)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00358(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 "C00358"',
     *  ' ',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(6)
      RS1=0.0
      DO 4 I00007=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(5)
      RS2=RS2-C00026(I00001,I00007,I00002)*C00117(I00001,I00007,I00002)*
     *  C00114(I00005,I00001,I00007,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00358(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 "C00358"',
     *  ' ',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,
     *  C00026,C00348,C00359,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL C00359(SSZ(5),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00007=1,SSZ(1)
      RS1=RS1-C00026(I00001,I00007,I00002)*C00348(I00001,I00007,I00002)
    3 CONTINUE
      C00359(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 "C00359"',
     *  ' ',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,
     *  C00026,C00348,C00360,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      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)
      REAL RS1
      LOGICAL ECHO1
      REAL C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL C00360(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 "C00360"',
     *  ' ',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(1)
      RS1=0.0
      DO 3 I00001=1,SSZ(5)
      RS1=RS1-C00026(I00001,I00007,I00002)*C00348(I00001,I00007,I00002)
    3 CONTINUE
      C00360(I00007,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('S00322')
      RETURN
      END
      SUBROUTINE S00323(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOCIG,
     *  C00026,C00348,C00361,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      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)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL C00361(SSZ(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 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00007=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(5)
      RS2=RS2-C00026(I00001,I00007,I00002)*C00348(I00001,I00007,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00361(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 "C00361"',
     *  ' ',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,
     *  C00026,C00114,C00117,C00362,
     *  ERRMES)
      USE PSIMMOD1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      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)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00362(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 "C00362"',
     *  ' ',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(6)
      RS1=0.0
      DO 4 I00007=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(5)
      RS2=RS2+C00026(I00001,I00007,I00002)*C00117(I00001,I00007,I00002)*
     *  C00114(I00005,I00001,I00007,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00362(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 "C00362"',
     *  ' ',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,
     *  C00026,C00114,C00117,C00363,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00363(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 "C00363"',
     *  ' ',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(6)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(5)
      RS2=RS2-C00026(I00001,I00003,I00002)*C00117(I00001,I00003,I00002)*
     *  C00114(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00363(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 "C00363"',
     *  ' ',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,
     *  C00026,C00348,C00364,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL C00364(SSZ(5),SSZ(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 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS1=RS1-C00026(I00001,I00003,I00002)*C00348(I00001,I00003,I00002)
    3 CONTINUE
      C00364(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 "C00364"',
     *  ' ',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,
     *  C00026,C00348,C00365,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL C00365(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 "C00365"',
     *  ' ',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(5)
      RS1=RS1-C00026(I00001,I00003,I00002)*C00348(I00001,I00003,I00002)
    3 CONTINUE
      C00365(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 "C00365"',
     *  ' ',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,
     *  C00026,C00348,C00366,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL C00366(SSZ(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 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)
      RS2=0.0
      DO 2 I00001=1,SSZ(5)
      RS2=RS2-C00026(I00001,I00003,I00002)*C00348(I00001,I00003,I00002)
    2 CONTINUE
      RS1=RS1+RS2
    3 CONTINUE
      C00366(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 "C00366"',
     *  ' ',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,
     *  C00026,C00114,C00117,C00367,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00367(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 "C00367"',
     *  ' ',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(6)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)
      RS2=0.0
      DO 3 I00001=1,SSZ(5)
      RS2=RS2+C00026(I00001,I00003,I00002)*C00117(I00001,I00003,I00002)*
     *  C00114(I00005,I00001,I00003,I00002)
    3 CONTINUE
      RS1=RS1+RS2
    4 CONTINUE
      C00367(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 "C00367"',
     *  ' ',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,
     *  C00026,C00114,C00117,C00368,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00368(SSZ(6),SSZ(5),SSZ(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 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(5)
      DO 1 I00005=1,SSZ(6)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)
      RS1=RS1-C00026(I00001,I00002,I00003)*C00117(I00001,I00002,I00003)*
     *  C00114(I00005,I00001,I00002,I00003)
    4 CONTINUE
      C00368(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 "C00368"',
     *  ' ',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,
     *  C00026,C00348,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
      LOGICAL ECHO1
      REAL C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL C00369(SSZ(5),SSZ(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 2 I00003=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)
      RS1=RS1-C00026(I00001,I00002,I00003)*C00348(I00001,I00002,I00003)
    3 CONTINUE
      C00369(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 "C00369"',
     *  ' ',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,
     *  C00026,C00114,C00117,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
      LOGICAL ECHO1
      REAL C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00370(SSZ(6),SSZ(5),SSZ(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 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(5)
      DO 1 I00005=1,SSZ(6)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)
      RS1=RS1+C00026(I00001,I00002,I00003)*C00117(I00001,I00002,I00003)*
     *  C00114(I00005,I00001,I00002,I00003)
    4 CONTINUE
      C00370(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 "C00370"',
     *  ' ',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,
     *  C00151,C00155,C00371,
     *  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 C00151(SSZ(5),SSZ(1))
      REAL C00155(SSZ(5),SSZ(1))
      REAL C00371(SSZ(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 1 I00002=1,SSZ(1)
      RS1=0.0
      DO 2 I00001=1,SSZ(5)
      RS1=RS1-(C00151(I00001,I00002)-C00155(I00001,I00002))
    2 CONTINUE
      C00371(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 "C00371"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00333')
      RETURN
      END
      SUBROUTINE M00012(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(1366).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00331',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1366).NE.'n') then
      CALL S00293(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1366),
     *  C00027,C00331,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1368).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00332',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1368).NE.'n') then
      CALL S00294(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1368),
     *  C00027,C00061,C00260,C00332,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1370).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00333',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1370).NE.'n') then
      CALL S00295(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1370),
     *  C00027,C00333,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1372).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00334',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1372).NE.'n') then
      CALL S00296(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1372),
     *  C00027,C00034,C00061,C00334,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1374).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00335',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1374).NE.'n') then
      CALL S00297(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1374),
     *  C00027,C00029,C00335,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1376).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00336',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1376).NE.'n') then
      CALL S00298(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1376),
     *  C00027,C00336,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1378).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00337',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1378).NE.'n') then
      CALL S00299(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1378),
     *  C00027,C00337,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1380).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00338',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1380).NE.'n') then
      CALL S00300(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1380),
     *  C00027,C00338,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1382).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00339',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1382).NE.'n') then
      CALL S00301(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1382),
     *  C00156,C00157,C00339,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1384).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00340',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1384).NE.'n') then
      CALL S00302(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1384),
     *  C00156,C00340,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1386).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00341',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1386).NE.'n') then
      CALL S00303(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1386),
     *  C00156,C00341,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1388).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00342',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1388).NE.'n') then
      CALL S00304(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1388),
     *  C00156,C00342,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1390).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00343',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1390).NE.'n') then
      CALL S00305(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1390),
     *  C00103,C00343,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1392).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00344',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1392).NE.'n') then
      CALL S00306(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1392),
     *  C00111,C00344,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1394).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00345',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1394).NE.'n') then
      CALL S00307(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1394),
     *  C00111,C00345,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1396).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00346',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1396).NE.'n') then
      CALL S00308(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1396),
     *  C00111,C00346,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1398).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00347',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1398).NE.'n') then
      CALL S00309(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1398),
     *  C00111,C00347,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1400).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00348',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1400).NE.'n') then
      CALL S00310(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1400),
     *  C00114,C00117,C00348,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1402).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00349',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1402).NE.'n') then
      CALL S00311(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1402),
     *  C00103,C00114,C00117,C00349,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1404).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00350',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1404).NE.'n') then
      CALL S00312(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1404),
     *  C00103,C00348,C00350,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1406).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00351',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1406).NE.'n') then
      CALL S00313(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1406),
     *  C00103,C00114,C00117,C00351,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1408).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00352',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1408).NE.'n') then
      CALL S00314(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1408),
     *  C00025,C00352,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1410).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00353',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1410).NE.'n') then
      CALL S00315(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1410),
     *  C00054,C00114,C00117,C00353,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1412).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00354',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1412).NE.'n') then
      CALL S00316(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1412),
     *  C00054,C00348,C00354,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1414).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00355',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1414).NE.'n') then
      CALL S00317(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1414),
     *  C00054,C00348,C00355,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1416).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00356',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1416).NE.'n') then
      CALL S00318(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1416),
     *  C00054,C00348,C00356,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1418).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00357',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1418).NE.'n') then
      CALL S00319(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1418),
     *  C00054,C00114,C00117,C00357,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1420).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00358',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1420).NE.'n') then
      CALL S00320(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1420),
     *  C00026,C00114,C00117,C00358,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1422).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00359',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1422).NE.'n') then
      CALL S00321(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1422),
     *  C00026,C00348,C00359,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1424).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00360',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1424).NE.'n') then
      CALL S00322(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1424),
     *  C00026,C00348,C00360,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1426).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00361',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1426).NE.'n') then
      CALL S00323(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1426),
     *  C00026,C00348,C00361,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1428).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00362',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1428).NE.'n') then
      CALL S00324(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1428),
     *  C00026,C00114,C00117,C00362,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1430).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00363',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1430).NE.'n') then
      CALL S00325(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1430),
     *  C00026,C00114,C00117,C00363,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1432).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00364',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1432).NE.'n') then
      CALL S00326(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1432),
     *  C00026,C00348,C00364,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1434).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00365',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1434).NE.'n') then
      CALL S00327(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1434),
     *  C00026,C00348,C00365,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1436).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00366',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1436).NE.'n') then
      CALL S00328(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1436),
     *  C00026,C00348,C00366,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1438).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00367',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1438).NE.'n') then
      CALL S00329(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1438),
     *  C00026,C00114,C00117,C00367,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1440).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00368',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1440).NE.'n') then
      CALL S00330(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1440),
     *  C00026,C00114,C00117,C00368,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1442).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00369',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1442).NE.'n') then
      CALL S00331(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1442),
     *  C00026,C00348,C00369,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1444).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00370',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1444).NE.'n') then
      CALL S00332(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1444),
     *  C00026,C00114,C00117,C00370,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1446).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00371',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1446).NE.'n') then
      CALL S00333(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,
     *  DOIG(1446),
     *  C00151,C00155,C00371,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00012')
      RETURN
      END
      SUBROUTINE S00334(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00061(SSZ(5),SSZ(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(5)
      RS1=-C00034(I00001,I00002)
      RS2=C00035(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00061(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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('S00334')
      RETURN
      END
      SUBROUTINE S00335(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00061(SSZ(5),SSZ(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(        8)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(5)
      RS1=-C00034(I00001,I00002)
      RS2=C00035(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00061(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00335')
      RETURN
      END
      SUBROUTINE S00340(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00056,C00061,
     *  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 I00016
      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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00056(SSZ(5))
      REAL C00061(SSZ(5),SSZ(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(5)
      RWN=RWN+1
      ENTRY=C00056(I00001)-(-1.0+C00056(I00001))*(1  -
     *  C00061(I00001,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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 I00016=1,SSZ(5)
      RS1=-C00034(I00016,I00003)
      RS2=C00035(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00061(I00016,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00016))+SSZ(12)*
     *  (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('S00340')
      RETURN
      END
      SUBROUTINE S00341(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00056,C00061,
     *  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 I00016
      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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00056(SSZ(5))
      REAL C00061(SSZ(5),SSZ(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(        8)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00003=1,SSZ(1)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-(-1.0+C00056(I00001))*C00061(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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 I00016=1,SSZ(5)
      RS1=-C00034(I00016,I00003)
      RS2=C00035(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00061(I00016,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00016+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00341')
      RETURN
      END
      SUBROUTINE S00345(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00262,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00262(SSZ(5),SSZ(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(5)
      ENTRY=C00262(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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('S00345')
      RETURN
      END
      SUBROUTINE S00350(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 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 C00038(SSZ(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(       45)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00038(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(45),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(45),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00350')
      RETURN
      END
      SUBROUTINE S00351(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00067,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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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,RS5,RS6
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00066(SSZ(1))
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(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_aUCONS"',
     *  ' in equation "E_aPHI"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aUCONS',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)
      DO     2 I00001=1,SSZ(30)
      RWN=RWN+1
      RS1=1.0
      RS2=C00067(I00001,I00002)+C00068(I00001,I00002)*
     *  EXP(REAL(C00066(I00002)))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=1.0
      RS5=1  +EXP(REAL(C00066(I00002)))
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IER=2
      END IF
      ENTRY=-(RS3*C00068(I00001,I00002)*EXP(REAL(C00066(I00002)))*
     *  C00066(I00002)-RS6*EXP(REAL(C00066(I00002)))*C00066(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(10),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
    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_aUCONS"',
     *  ' in equation "E_aPHI"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00351')
      RETURN
      END
      SUBROUTINE S00353(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00067,C00068,C00069,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00017
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15,RS16,RS17
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(30),SSZ(1))
      REAL C00066(SSZ(1))
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(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_aQP"',
     *  ' in equation "E_aEPSIN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aQP',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
      RS1=0.0
      DO 2 I00017=1,SSZ(30)
      RS2=REAL(C00065(I00017,I00002)-C00069(I00017,I00002))
      IF(RS2.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      RS1=RS1+(C00068(I00017,I00002)-C00067(I00017,I00002))*LOG(RS2)
    2 CONTINUE
      DO 3 I00001=1,SSZ(30)
      RS3=1  +EXP(REAL(C00066(I00002)))
      RS4=2
      IF(RS3.GT.0.0) THEN
        RS5=RS3**RS4
      ELSE IF(RS3.EQ.0.0 .AND. RS4.GT.0.0) THEN
        RS5=0.0
      ELSE IF(RS3.EQ.0.0 .AND. RS4.EQ.0.0) THEN
        RS5=1.0
        IER=11
      ELSE IF(RS3.EQ.0.0 .AND. RS4.LT.0.0) THEN
        RS5=1.0
        IER=12
      ELSE
        IF(RS4.EQ.0.0) THEN
          RS5=1.0
          IER=13
        ELSE IF(INT(RS4).EQ.RS4) THEN
          RS5=RS3**INT(RS4)
        ELSE
          RS5=1.0
          IER=14
        END IF
      END IF
      RS6=RS5
      RS7=EXP(REAL(C00066(I00002)))
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS9=RS1-(RS8)
      RS10=2
      IF(RS9.GT.0.0) THEN
        RS11=RS9**RS10
      ELSE IF(RS9.EQ.0.0 .AND. RS10.GT.0.0) THEN
        RS11=0.0
      ELSE IF(RS9.EQ.0.0 .AND. RS10.EQ.0.0) THEN
        RS11=1.0
        IER=11
      ELSE IF(RS9.EQ.0.0 .AND. RS10.LT.0.0) THEN
        RS11=1.0
        IER=12
      ELSE
        IF(RS10.EQ.0.0) THEN
          RS11=1.0
          IER=13
        ELSE IF(INT(RS10).EQ.RS10) THEN
          RS11=RS9**INT(RS10)
        ELSE
          RS11=1.0
          IER=14
        END IF
      END IF
      RS12=1.0
      RS13=RS11
      IF(RS13.NE.0.0) THEN
        RS14=RS12/RS13
      ELSE
        RS14=1.0
        IER=2
      END IF
      RS15=RS14*(C00068(I00001,I00002)-C00067(I00001,I00002))
      RS16=C00065(I00001,I00002)-C00069(I00001,I00002)
      IF(RS16.NE.0.0) THEN
        RS17=RS15/RS16
      ELSE
        RS17=1.0
        IER=2
      END IF
      ENTRY=RS17*C00065(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(30)*(I00002-1)
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(11),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 "p_aQP"',
     *  ' in equation "E_aEPSIN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00353')
      RETURN
      END
      SUBROUTINE S00354(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00067,C00068,C00069,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15,RS16,RS17,RS18,RS19,RS20,RS21,RS22,RS23,RS24,RS25,RS26
      REAL RS27,RS28,RS29
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(30),SSZ(1))
      REAL C00066(SSZ(1))
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(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_aUCONS"',
     *  ' in equation "E_aEPSIN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aUCONS',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
      RS1=0.0
      DO 2 I00001=1,SSZ(30)
      RS2=REAL(C00065(I00001,I00002)-C00069(I00001,I00002))
      IF(RS2.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      RS1=RS1+(C00068(I00001,I00002)-C00067(I00001,I00002))*LOG(RS2)
    2 CONTINUE
      RS3=1  +EXP(REAL(C00066(I00002)))
      RS4=2
      IF(RS3.GT.0.0) THEN
        RS5=RS3**RS4
      ELSE IF(RS3.EQ.0.0 .AND. RS4.GT.0.0) THEN
        RS5=0.0
      ELSE IF(RS3.EQ.0.0 .AND. RS4.EQ.0.0) THEN
        RS5=1.0
        IER=11
      ELSE IF(RS3.EQ.0.0 .AND. RS4.LT.0.0) THEN
        RS5=1.0
        IER=12
      ELSE
        IF(RS4.EQ.0.0) THEN
          RS5=1.0
          IER=13
        ELSE IF(INT(RS4).EQ.RS4) THEN
          RS5=RS3**INT(RS4)
        ELSE
          RS5=1.0
          IER=14
        END IF
      END IF
      RS6=RS5
      RS7=EXP(REAL(C00066(I00002)))
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS9=RS1-(RS8)
      RS10=2
      IF(RS9.GT.0.0) THEN
        RS11=RS9**RS10
      ELSE IF(RS9.EQ.0.0 .AND. RS10.GT.0.0) THEN
        RS11=0.0
      ELSE IF(RS9.EQ.0.0 .AND. RS10.EQ.0.0) THEN
        RS11=1.0
        IER=11
      ELSE IF(RS9.EQ.0.0 .AND. RS10.LT.0.0) THEN
        RS11=1.0
        IER=12
      ELSE
        IF(RS10.EQ.0.0) THEN
          RS11=1.0
          IER=13
        ELSE IF(INT(RS10).EQ.RS10) THEN
          RS11=RS9**INT(RS10)
        ELSE
          RS11=1.0
          IER=14
        END IF
      END IF
      RS12=-1.0
      RS13=RS11
      IF(RS13.NE.0.0) THEN
        RS14=RS12/RS13
      ELSE
        RS14=1.0
        IER=2
      END IF
      RS15=1.0
      RS16=EXP(REAL(C00066(I00002)))
      IF(RS16.NE.0.0) THEN
        RS17=RS15/RS16
      ELSE
        RS17=1.0
        IER=2
      END IF
      RS18=1  +EXP(REAL(C00066(I00002)))
      RS19=2  -1
      IF(RS18.GT.0.0) THEN
        RS20=RS18**RS19
      ELSE IF(RS18.EQ.0.0 .AND. RS19.GT.0.0) THEN
        RS20=0.0
      ELSE IF(RS18.EQ.0.0 .AND. RS19.EQ.0.0) THEN
        RS20=1.0
        IER=11
      ELSE IF(RS18.EQ.0.0 .AND. RS19.LT.0.0) THEN
        RS20=1.0
        IER=12
      ELSE
        IF(RS19.EQ.0.0) THEN
          RS20=1.0
          IER=13
        ELSE IF(INT(RS19).EQ.RS19) THEN
          RS20=RS18**INT(RS19)
        ELSE
          RS20=1.0
          IER=14
        END IF
      END IF
      RS21=1  +EXP(REAL(C00066(I00002)))
      RS22=2
      IF(RS21.GT.0.0) THEN
        RS23=RS21**RS22
      ELSE IF(RS21.EQ.0.0 .AND. RS22.GT.0.0) THEN
        RS23=0.0
      ELSE IF(RS21.EQ.0.0 .AND. RS22.EQ.0.0) THEN
        RS23=1.0
        IER=11
      ELSE IF(RS21.EQ.0.0 .AND. RS22.LT.0.0) THEN
        RS23=1.0
        IER=12
      ELSE
        IF(RS22.EQ.0.0) THEN
          RS23=1.0
          IER=13
        ELSE IF(INT(RS22).EQ.RS22) THEN
          RS23=RS21**INT(RS22)
        ELSE
          RS23=1.0
          IER=14
        END IF
      END IF
      RS24=EXP(REAL(C00066(I00002)))
      RS25=2
      IF(RS24.GT.0.0) THEN
        RS26=RS24**RS25
      ELSE IF(RS24.EQ.0.0 .AND. RS25.GT.0.0) THEN
        RS26=0.0
      ELSE IF(RS24.EQ.0.0 .AND. RS25.EQ.0.0) THEN
        RS26=1.0
        IER=11
      ELSE IF(RS24.EQ.0.0 .AND. RS25.LT.0.0) THEN
        RS26=1.0
        IER=12
      ELSE
        IF(RS25.EQ.0.0) THEN
          RS26=1.0
          IER=13
        ELSE IF(INT(RS25).EQ.RS25) THEN
          RS26=RS24**INT(RS25)
        ELSE
          RS26=1.0
          IER=14
        END IF
      END IF
      RS27=RS23
      RS28=RS26
      IF(RS28.NE.0.0) THEN
        RS29=RS27/RS28
      ELSE
        RS29=1.0
        IER=2
      END IF
      ENTRY=RS14*(RS17*2  *(RS20)*EXP(REAL(C00066(I00002)))*
     *  C00066(I00002)-(RS29)*EXP(REAL(C00066(I00002)))*C00066(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(11),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 "p_aUCONS"',
     *  ' in equation "E_aEPSIN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00354')
      RETURN
      END
      SUBROUTINE S00356(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00069,C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00065(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00071(SSZ(30),SSZ(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_aQP"',
     *  ' in equation "aPRIVATEU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aQP',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
      DO 2 I00001=1,SSZ(30)
      RS1=C00071(I00001,I00002)
      RS2=C00065(I00001,I00002)-C00069(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00065(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(30)*(I00002-1)
        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
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(12),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 "p_aQP"',
     *  ' in equation "aPRIVATEU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00356')
      RETURN
      END
      SUBROUTINE S00358(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00069,C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00065(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00071(SSZ(30),SSZ(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_aPHI"',
     *  ' in equation "aPRIVATEU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aPHI',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
      DO 2 I00001=1,SSZ(30)
      RS1=REAL(C00065(I00001,I00002)-C00069(I00001,I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=LOG(RS1)*C00071(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(30)*(I00002-1)
        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
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(12),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 "p_aPHI"',
     *  ' in equation "aPRIVATEU"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00358')
      RETURN
      END
      SUBROUTINE S00375(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00036,C00062,C00063,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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
      REAL C00036(SSZ(5),SSZ(1))
      INTEGER C00062(SSZ(30))
      INTEGER C00063(SSZ(5))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppp"',
     *  ' in equation "PRODCOMPP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       69)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(30)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(5)
      RS1=0.0
      LG1=C00063(I00001).EQ.C00062(I00005)
      IF(LG1) THEN
      RS1=-C00036(I00001,I00002)
      END IF
      ENTRY=RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005+SSZ(30)*(I00001-1+SSZ(5)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),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(19),COLBF(69),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "dppp"',
     *  ' in equation "PRODCOMPP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00375')
      RETURN
      END
      SUBROUTINE S00379(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00081,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 I00001
      INTEGER I00002
      INTEGER I00009
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00081(SSZ(30),SSZ(5),SSZ(1))
      REAL C00084(SSZ(30))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppp"',
     *  ' in equation "MKTCLR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppp',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)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00009=1,SSZ(30)
      ENTRY=-C00081(I00009,I00001,I00002)*C00084(I00009)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00009+SSZ(30)*(I00002-1)
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(22),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
    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 "ppp"',
     *  ' in equation "MKTCLR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00379')
      RETURN
      END
      SUBROUTINE S00381(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00081,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 I00001
      INTEGER I00002
      INTEGER I00009
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00081(SSZ(30),SSZ(5),SSZ(1))
      REAL C00084(SSZ(30))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppp"',
     *  ' in equation "MKTCLR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       69)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00009=1,SSZ(30)
      ENTRY=C00081(I00009,I00001,I00002)*C00084(I00009)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00009+SSZ(30)*(I00001-1+SSZ(5)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),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(22),COLBF(69),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "dppp"',
     *  ' in equation "MKTCLR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00381')
      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''',
     *    'GOVU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00334(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00335(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(32),ECHO1,
     *  ROWBF(3),COLBF(32),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(36),ECHO1,
     *  ROWBF(3),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(37),ECHO1,
     *  ROWBF(3),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''',
     *    '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 S00340(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00056,C00061,
     *  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 S00341(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00056,C00061,
     *  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(32),ECHO1,
     *  ROWBF(8),COLBF(32),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(8),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''',
     *    '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(5),SSZ(1),1,1,1,1,1,C00039,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00345(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00262,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(8),ECHO1,
     *  ROWBF(9),COLBF(8),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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(31),ECHO1,
     *  ROWBF(9),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00041,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(32),ECHO1,
     *  ROWBF(9),COLBF(32),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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(37),ECHO1,
     *  ROWBF(9),COLBF(37),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00350(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(45),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'E_aPHI',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00351(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00066,C00067,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(63),ECHO1,
     *  ROWBF(10),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'E_aEPSIN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00353(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(60),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00067,C00068,C00069,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00354(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00067,C00068,C00069,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(64),ECHO1,
     *  ROWBF(11),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'aPRIVATEU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00356(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(60),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00069,C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(62),ECHO1,
     *  ROWBF(12),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00066,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00358(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(63),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00069,C00071,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'UTILTRANS',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(62),ECHO1,
     *  ROWBF(13),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00066,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(13),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVATUP',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(40),ECHO1,
     *  ROWBF(14),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(65),ECHO1,
     *  ROWBF(14),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOTDEMAND',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(32),ECHO1,
     *  ROWBF(15),COLBF(32),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(60),ECHO1,
     *  ROWBF(15),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(15),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVDMNDS2',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(32),ECHO1,
     *  ROWBF(16),COLBF(32),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(30),SSZ(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(39),ECHO1,
     *  ROWBF(16),COLBF(39),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(30),SSZ(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(59),ECHO1,
     *  ROWBF(16),COLBF(59),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(30),SSZ(30),SSZ(1),1,1,1,1,C00078,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(60),ECHO1,
     *  ROWBF(16),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONSPRICESB',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(17),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(66),ECHO1,
     *  ROWBF(17),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRODCOMPQ',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(61),ECHO1,
     *  ROWBF(18),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(67),ECHO1,
     *  ROWBF(18),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRODCOMPP',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(66),ECHO1,
     *  ROWBF(19),COLBF(66),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(30),SSZ(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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00375(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(69),KZC,DOEQ,STRHS,STRHNZ,
     *  C00036,C00062,C00063,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'PRICELINK1',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(57),ECHO1,
     *  ROWBF(20),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(69),ECHO1,
     *  ROWBF(20),COLBF(69),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''',
     *    'MKTCLR',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(22),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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 S00379(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(66),KZC,DOEQ,STRHS,STRHNZ,
     *  C00081,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(67),ECHO1,
     *  ROWBF(22),COLBF(67),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(30),SSZ(5),SSZ(1),1,1,1,1,C00081,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00381(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(69),KZC,DOEQ,STRHS,STRHNZ,
     *  C00081,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''',
     *    '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(38),ECHO1,
     *  ROWBF(23),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(57),ECHO1,
     *  ROWBF(23),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00060,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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('M00013')
      RETURN
      END
      SUBROUTINE S00385(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 "atpd"',
     *  ' in equation "TPDSHIFT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       72)
      DO     1 I00002=1,SSZ(1)
      DO     2 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(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(72),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(72),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "TPDSHIFT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00385')
      RETURN
      END
      SUBROUTINE S00386(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 "atpd"',
     *  ' in equation "TPDSHIFTFD"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       72)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(19)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(18)-1+I00001)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(72),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(25),COLBF(72),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "TPDSHIFTFD"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00386')
      RETURN
      END
      SUBROUTINE S00389(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(5),SSZ(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(5)
      ENTRY=-C00042(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(29),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('S00389')
      RETURN
      END
      SUBROUTINE S00390(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00056,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00043(SSZ(5),SSZ(1))
      REAL C00056(SSZ(5))
      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(        8)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(5)
      ENTRY=-C00043(I00001,I00002)*(1.0-C00056(I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(29),COLBF(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00390')
      RETURN
      END
      SUBROUTINE S00393(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 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 C00038(SSZ(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(       46)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00038(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        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(29),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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('S00393')
      RETURN
      END
      SUBROUTINE S00394(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00056,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00043(SSZ(5),SSZ(1))
      REAL C00056(SSZ(5))
      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 "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''',
     *    'pp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       57)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(5)
      ENTRY=-C00043(I00001,I00002)*C00056(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(57),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(29),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "TPCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00394')
      RETURN
      END
      SUBROUTINE S00397(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00015,C00043,C00056,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00015(SSZ(5),SSZ(1))
      REAL C00043(SSZ(5),SSZ(1))
      REAL C00056(SSZ(5))
      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(       74)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(5)
      ENTRY=-(C00015(I00001,I00002)-C00043(I00001,I00002)*
     *  C00056(I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(74),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(29),COLBF(74),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00397')
      RETURN
      END
      SUBROUTINE S00398(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  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 C00085(SSZ(5),SSZ(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(5)
      RWN=RWN+1
      ENTRY=-(1  -C00085(I00001,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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
    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('S00398')
      RETURN
      END
      SUBROUTINE S00401(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  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 C00085(SSZ(5),SSZ(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(       72)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-(1  -C00085(I00001,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(72),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(72),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 S00403(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  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 C00056(SSZ(5))
      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(5)
      RWN=RWN+1
      ENTRY=C00056(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(31),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('S00403')
      RETURN
      END
      SUBROUTINE S00412(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00086(SSZ(10),SSZ(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 "PURCHDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       13)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(15)
      RWN=RWN+1
      ENTRY=-C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)))+SSZ(12)*(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(37),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 "ps"',
     *  ' in equation "PURCHDEMAND"',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 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 "PURCHDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(15)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "PURCHDEMAND"',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,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00086(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppurch"',
     *  ' in equation "PURCHDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppurch',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(15)
      RWN=RWN+1
      ENTRY=C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(15)*(I00002-1)
        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
    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 "ppurch"',
     *  ' in equation "PURCHDEMAND"',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,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00086(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "apurch"',
     *  ' in equation "PURCHDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'apurch',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(15)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(15)*(I00002-1)
        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(37),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
    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 "apurch"',
     *  ' in equation "PURCHDEMAND"',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,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00086(SSZ(10),SSZ(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 "PURCHDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       88)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(15)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        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(37),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
    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 "PURCHDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00417')
      RETURN
      END
      SUBROUTINE S00418(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00086(SSZ(10),SSZ(1))
      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 "PURCHDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       89)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(15)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        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(37),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
    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 "PURCHDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00418')
      RETURN
      END
      SUBROUTINE S00419(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00086(SSZ(10),SSZ(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 "PURCHDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       90)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(15)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))+SSZ(10)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(90),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(90),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "aoall"',
     *  ' in equation "PURCHDEMAND"',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,
     *  C00086,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 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 C00086(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(16)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00086(SSMP(SSMPST(13)-1+I00004),I00002)*(1  -
     *  C00096(I00001,SSMP(SSMPST(13)-1+I00004),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(38),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 "INTDEMANDNAGR"',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,
     *  C00086,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 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 C00086(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(        8)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(16)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00086(SSMP(SSMPST(13)-1+I00004),I00002)*
     *  C00096(I00001,SSMP(SSMPST(13)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(38),COLBF(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00421')
      RETURN
      END
      SUBROUTINE S00422(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       13)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(16)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00086(SSMP(SSMPST(13)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(13)-1+I00004))+SSZ(12)*
     *  (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(38),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
    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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00422')
      RETURN
      END
      SUBROUTINE S00423(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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(16)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(13)-1+I00004))+SSZ(12)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(38),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00423')
      RETURN
      END
      SUBROUTINE S00424(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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(16)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(SSMP(SSMPST(13)-1+I00004)-1+SSZ(10)*
     *  (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(38),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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00424')
      RETURN
      END
      SUBROUTINE S00425(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       98)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(16)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(SSMP(SSMPST(13)-1+I00004),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        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(38),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
    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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00425')
      RETURN
      END
      SUBROUTINE S00426(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       99)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(16)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(SSMP(SSMPST(13)-1+I00004),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00004)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(99),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(38),COLBF(99),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDNAGR"',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,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      100)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(16)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(SSMP(SSMPST(13)-1+I00004),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(100),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(38),COLBF(100),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDNAGR"',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,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(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 "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(16)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(SSMP(SSMPST(13)-1+I00004),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(SSMP(SSMPST(13)-1+I00004)-1+SSZ(10)*
     *  (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(38),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 "afall"',
     *  ' in equation "INTDEMANDNAGR"',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,
     *  C00086,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 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 C00086(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(16)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00086(SSMP(SSMPST(13)-1+I00004),I00002)*(1  -
     *  C00096(I00001,SSMP(SSMPST(13)-1+I00004),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(SSMP(SSMPST(13)-1+I00004)-1+SSZ(10)*
     *  (I00002-1))
        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(38),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 "tfd"',
     *  ' in equation "INTDEMANDNAGR"',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,
     *  C00086,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 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 C00086(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "INTDEMANDNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(16)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00086(SSMP(SSMPST(13)-1+I00004),I00002)*
     *  C00096(I00001,SSMP(SSMPST(13)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(SSMP(SSMPST(13)-1+I00004)-1+SSZ(10)*
     *  (I00002-1))
        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(38),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 "tfm"',
     *  ' in equation "INTDEMANDNAGR"',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,
     *  C00087,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00087(SSZ(5),SSZ(15),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(22)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(5)
      ENTRY=-C00087(I00007,SSMP(SSMPST(21)-1+I00004),I00002)*(1  -
     *  C00096(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00007))+SSZ(12)*
     *  (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(40),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 "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00431')
      RETURN
      END
      SUBROUTINE S00432(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00087(SSZ(5),SSZ(15),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(        8)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(5)
      ENTRY=-C00087(I00007,SSMP(SSMPST(21)-1+I00004),I00002)*
     *  C00096(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00432')
      RETURN
      END
      SUBROUTINE S00433(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 "ppurch"',
     *  ' in equation "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppurch',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(22)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(21)-1+I00004)+SSZ(15)*(I00002-1)
        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(40),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
    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 "ppurch"',
     *  ' in equation "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00433')
      RETURN
      END
      SUBROUTINE S00434(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00087(SSZ(5),SSZ(15),SSZ(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 "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       98)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(5)
      ENTRY=C00087(I00007,SSMP(SSMPST(21)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(40),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
    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 "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00434')
      RETURN
      END
      SUBROUTINE S00435(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00266,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00266(SSZ(22),SSZ(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 "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       99)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      RWN=RWN+1
      ENTRY=C00266(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+
     *  I00004)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(99),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(40),COLBF(99),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afsec"',
     *  ' in equation "PURCHPRICENL"',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,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00087(SSZ(5),SSZ(15),SSZ(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 "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(5)
      ENTRY=C00087(I00007,SSMP(SSMPST(21)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(5)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004)))-1+SSZ(10)*(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(40),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 "afall"',
     *  ' in equation "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00437')
      RETURN
      END
      SUBROUTINE S00438(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00087(SSZ(5),SSZ(15),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(5)
      ENTRY=-C00087(I00007,SSMP(SSMPST(21)-1+I00004),I00002)*(1  -
     *  C00096(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(5)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004)))-1+SSZ(10)*(I00002-1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(40),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
    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 "tfd"',
     *  ' in equation "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00438')
      RETURN
      END
      SUBROUTINE S00439(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00087(SSZ(5),SSZ(15),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(5)
      ENTRY=-C00087(I00007,SSMP(SSMPST(21)-1+I00004),I00002)*
     *  C00096(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(5)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004)))-1+SSZ(10)*(I00002-1))
        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(40),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 "tfm"',
     *  ' in equation "PURCHPRICENL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00439')
      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''',
     *    '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(70),ECHO1,
     *  ROWBF(24),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00385(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(72),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''',
     *    'TPDSHIFTFD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00386(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(72),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''',
     *    '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(70),ECHO1,
     *  ROWBF(27),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(74),ECHO1,
     *  ROWBF(27),COLBF(74),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 S00389(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),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 S00390(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00056,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(10),ECHO1,
     *  ROWBF(29),COLBF(10),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00042,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(29),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00044,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00393(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(46),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 S00394(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00056,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(58),ECHO1,
     *  ROWBF(29),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00043,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(29),COLBF(72),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00013,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(74),KZC,DOEQ,STRHS,STRHNZ,
     *  C00015,C00043,C00056,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'PCOMPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00398(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(8),ECHO1,
     *  ROWBF(30),COLBF(8),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(57),ECHO1,
     *  ROWBF(30),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00401(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(72),KZC,DOEQ,STRHS,STRHNZ,
     *  C00085,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(74),ECHO1,
     *  ROWBF(30),COLBF(74),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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''',
     *    'PHHLDDOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00403(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(10),ECHO1,
     *  ROWBF(31),COLBF(10),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(31),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00056,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(58),ECHO1,
     *  ROWBF(31),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(72),ECHO1,
     *  ROWBF(31),COLBF(72),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00056,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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''',
     *    'PURCHWORLD',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(87),ECHO1,
     *  ROWBF(35),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(95),ECHO1,
     *  ROWBF(35),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(96),ECHO1,
     *  ROWBF(35),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(97),ECHO1,
     *  ROWBF(35),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''',
     *    'PURCHDEMAND',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(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(14),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 S00414(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(84),ECHO1,
     *  ROWBF(37),COLBF(84),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 S00416(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00418(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00419(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'INTDEMANDNAGR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00420(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,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 S00421(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,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 S00422(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00423(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),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 S00424(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 S00425(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(98),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00426(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(99),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(100),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00429(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,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 S00430(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PURCHPRICENL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00431(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,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 S00432(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,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 S00433(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),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 S00434(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(98),KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00435(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(99),KZC,DOEQ,STRHS,STRHNZ,
     *  C00266,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(40),COLBF(100),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(22),SSZ(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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00437(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00438(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,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 S00439(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00087,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
      RETURN
15000 CALL PERET('M00014')
      RETURN
      END
      SUBROUTINE S00440(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(5),SSZ(21),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(21)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(24)
      ENTRY=-C00088(SSMP(SSMPST(23)-1+I00007),I00004,I00002)*(1  -
     *  C00096(SSMP(SSMPST(23)-1+I00007),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(23)-1+
     *  I00007)))+SSZ(12)*(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(41),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 "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00440')
      RETURN
      END
      SUBROUTINE S00441(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(5),SSZ(21),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(        8)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(24)
      ENTRY=-C00088(SSMP(SSMPST(23)-1+I00007),I00004,I00002)*
     *  C00096(SSMP(SSMPST(23)-1+I00007),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00007)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(41),COLBF(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "PURCHPRICELSTK"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 "ppurch"',
     *  ' in equation "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppurch',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(21)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(20)-1+I00004)+SSZ(15)*(I00002-1)
        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
    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 "ppurch"',
     *  ' in equation "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00442')
      RETURN
      END
      SUBROUTINE S00444(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(5),SSZ(21),SSZ(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 "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       98)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(24)
      ENTRY=C00088(SSMP(SSMPST(23)-1+I00007),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00007)
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),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
    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 "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00444')
      RETURN
      END
      SUBROUTINE S00445(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00268,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00268(SSZ(21),SSZ(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 "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       99)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      RWN=RWN+1
      ENTRY=C00268(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(99),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(99),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afsec"',
     *  ' in equation "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00445')
      RETURN
      END
      SUBROUTINE S00447(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(5),SSZ(21),SSZ(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 "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(24)
      ENTRY=C00088(SSMP(SSMPST(23)-1+I00007),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00007)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(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(41),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 "afall"',
     *  ' in equation "PURCHPRICELSTK"',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,
     *  C00088,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(5),SSZ(21),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(24)
      ENTRY=-C00088(SSMP(SSMPST(23)-1+I00007),I00004,I00002)*(1  -
     *  C00096(SSMP(SSMPST(23)-1+I00007),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00007)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(I00002-
     *  1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),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
    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 "tfd"',
     *  ' in equation "PURCHPRICELSTK"',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,
     *  C00088,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(5),SSZ(21),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "PURCHPRICELSTK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(24)
      ENTRY=-C00088(SSMP(SSMPST(23)-1+I00007),I00004,I00002)*
     *  C00096(SSMP(SSMPST(23)-1+I00007),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00007)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(I00002-
     *  1))
        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(41),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 "tfm"',
     *  ' in equation "PURCHPRICELSTK"',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,
     *  C00089,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 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 C00089(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(22)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+
     *  I00004))),I00002)*(1  -C00096(I00001,SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(42),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 "INTDEMANDNONL"',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,
     *  C00089,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 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 C00089(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(        8)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+
     *  I00004))),I00002)*C00096(I00001,SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(42),COLBF(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDNONL"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(22)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004)))-1+SSZ(10)*(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(42),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 "INTDEMANDNONL"',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,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00089(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppurch"',
     *  ' in equation "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppurch',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(22)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-
     *  1+I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(21)-1+I00004)+SSZ(15)*(I00002-1)
        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(42),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 "ppurch"',
     *  ' in equation "INTDEMANDNONL"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 "qpurch"',
     *  ' in equation "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpurch',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(22)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(21)-1+I00004)+SSZ(15)*(I00002-1)
        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(42),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 "qpurch"',
     *  ' in equation "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00454')
      RETURN
      END
      SUBROUTINE S00455(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00089(SSZ(10),SSZ(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 "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       98)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-(-1.0+C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        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(42),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
    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 "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00455')
      RETURN
      END
      SUBROUTINE S00456(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00089(SSZ(10),SSZ(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 "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       99)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-(-1.0+C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+
     *  I00004)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(99),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(42),COLBF(99),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00456')
      RETURN
      END
      SUBROUTINE S00457(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00089(SSZ(10),SSZ(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 "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      100)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-(-1.0+C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(100),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(42),COLBF(100),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00457')
      RETURN
      END
      SUBROUTINE S00458(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00089(SSZ(10),SSZ(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 "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-(-1.0+C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004)))-1+SSZ(10)*(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(42),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 "afall"',
     *  ' in equation "INTDEMANDNONL"',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,
     *  C00089,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 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 C00089(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+
     *  I00004))),I00002)*(1  -C00096(I00001,SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004)))-1+SSZ(10)*(I00002-1))
        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(42),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 "tfd"',
     *  ' in equation "INTDEMANDNONL"',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,
     *  C00089,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 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 C00089(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "INTDEMANDNONL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(22)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+
     *  I00004))),I00002)*C00096(I00001,SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(21)-1+I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(21)-1+I00004)))-1+SSZ(10)*(I00002-1))
        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(42),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 "tfm"',
     *  ' in equation "INTDEMANDNONL"',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,
     *  C00089,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 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 C00089(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(21)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)*(1  -C00096(SSMP(SSMPST(23)-1+
     *  I00001),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(23)-1+
     *  I00001)))+SSZ(12)*(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(43),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 "INTDEMANDNONF"',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,
     *  C00089,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 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 C00089(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(        8)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)*C00096(SSMP(SSMPST(23)-1+
     *  I00001),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00001)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDNONF"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(21)
      DO     3 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(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(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(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
    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 "INTDEMANDNONF"',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,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00089(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppurch"',
     *  ' in equation "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppurch',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(21)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=-C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-
     *  1+I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(20)-1+I00004)+SSZ(15)*(I00002-1)
        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 "ppurch"',
     *  ' in equation "INTDEMANDNONF"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 "qpurch"',
     *  ' in equation "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpurch',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(21)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(20)-1+I00004)+SSZ(15)*(I00002-1)
        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 "qpurch"',
     *  ' in equation "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00465')
      RETURN
      END
      SUBROUTINE S00466(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00089(SSZ(10),SSZ(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 "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       98)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=-(-1.0+C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00001)
        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(43),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
    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 "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00466')
      RETURN
      END
      SUBROUTINE S00467(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00089(SSZ(10),SSZ(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 "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       99)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=-(-1.0+C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(99),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(99),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00467')
      RETURN
      END
      SUBROUTINE S00468(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00089(SSZ(10),SSZ(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 "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      100)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=-(-1.0+C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(100),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(100),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDNONF"',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,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00089(SSZ(10),SSZ(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 "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=-(-1.0+C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00001)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(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(43),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 "afall"',
     *  ' in equation "INTDEMANDNONF"',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,
     *  C00089,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 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 C00089(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)*(1  -C00096(SSMP(SSMPST(23)-1+
     *  I00001),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00001)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(I00002-
     *  1))
        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(43),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 "tfd"',
     *  ' in equation "INTDEMANDNONF"',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,
     *  C00089,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 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 C00089(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "INTDEMANDNONF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(24)
      RWN=RWN+1
      ENTRY=C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)*C00096(SSMP(SSMPST(23)-1+
     *  I00001),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(23)-1+I00001)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(I00002-
     *  1))
        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(43),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 "tfm"',
     *  ' in equation "INTDEMANDNONF"',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,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00089(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ppurch"',
     *  ' in equation "FSDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ppurch',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(21)
      RWN=RWN+1
      ENTRY=-C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-
     *  1+I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(20)-1+I00004)+SSZ(15)*(I00002-1)
        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(44),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
    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 "ppurch"',
     *  ' in equation "FSDEMAND"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 "qpurch"',
     *  ' in equation "FSDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpurch',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(21)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(20)-1+I00004)+SSZ(15)*(I00002-1)
        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(44),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
    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 "qpurch"',
     *  ' in equation "FSDEMAND"',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,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00089(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfs"',
     *  ' in equation "FSDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfs',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(21)
      RWN=RWN+1
      ENTRY=C00089(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(21)*(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(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 "pfs"',
     *  ' in equation "FSDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00474')
      RETURN
      END
      SUBROUTINE S00476(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00091,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00091(SSZ(23),SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "FSPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(21)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(23)
      ENTRY=-C00091(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002)*(1  -C00096(SSMP(SSMPST(22)-
     *  1+I00007),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(22)-1+
     *  I00007)))+SSZ(12)*(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(45),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 "FSPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00476')
      RETURN
      END
      SUBROUTINE S00477(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00091,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00091(SSZ(23),SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "FSPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(        8)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(23)
      ENTRY=-C00091(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002)*C00096(SSMP(SSMPST(22)-1+
     *  I00007),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+I00007)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(45),COLBF(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "FSPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00477')
      RETURN
      END
      SUBROUTINE S00479(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00091,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00091(SSZ(23),SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "FSPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(23)
      ENTRY=-C00091(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002)*(1  -C00096(SSMP(SSMPST(22)-
     *  1+I00007),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+I00007)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(I00002-
     *  1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(45),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
    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 "tfd"',
     *  ' in equation "FSPRICE"',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,
     *  C00091,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 I00002
      INTEGER I00004
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00091(SSZ(23),SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "FSPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(23)
      ENTRY=-C00091(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002)*C00096(SSMP(SSMPST(22)-1+
     *  I00007),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+I00007)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(I00002-
     *  1))
        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(45),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 "tfm"',
     *  ' in equation "FSPRICE"',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,
     *  C00090,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 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 C00090(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(21)
      DO     3 I00001=1,SSZ(23)
      RWN=RWN+1
      ENTRY=C00090(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)*(1  -C00096(SSMP(SSMPST(22)-1+
     *  I00001),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(22)-1+
     *  I00001)))+SSZ(12)*(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(46),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 "INTDEMANDFS"',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,
     *  C00090,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 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 C00090(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(        8)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(23)
      RWN=RWN+1
      ENTRY=C00090(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)*C00096(SSMP(SSMPST(22)-1+
     *  I00001),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+I00001)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(46),COLBF(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDFS"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(21)
      DO     3 I00001=1,SSZ(23)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+I00001)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(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(46),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 "INTDEMANDFS"',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,
     *  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 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 C00090(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfs"',
     *  ' in equation "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfs',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(21)
      DO     3 I00001=1,SSZ(23)
      RWN=RWN+1
      ENTRY=-C00090(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-
     *  1+I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(21)*(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(46),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 "pfs"',
     *  ' in equation "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00484')
      RETURN
      END
      SUBROUTINE S00486(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 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 C00090(SSZ(10),SSZ(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 "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       98)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(23)
      RWN=RWN+1
      ENTRY=-(-1.0+C00090(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+I00001)
        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(46),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
    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 "INTDEMANDFS"',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,
     *  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 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 C00090(SSZ(10),SSZ(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 "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       99)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(23)
      RWN=RWN+1
      ENTRY=-(-1.0+C00090(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(99),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(46),COLBF(99),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00487')
      RETURN
      END
      SUBROUTINE S00488(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 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 C00090(SSZ(10),SSZ(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 "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      100)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(23)
      RWN=RWN+1
      ENTRY=-(-1.0+C00090(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(100),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(46),COLBF(100),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00488')
      RETURN
      END
      SUBROUTINE S00489(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 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 C00090(SSZ(10),SSZ(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 "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(23)
      RWN=RWN+1
      ENTRY=-(-1.0+C00090(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  SSMP(SSMPST(20)-1+I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+I00001)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(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(46),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 "afall"',
     *  ' in equation "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00489')
      RETURN
      END
      SUBROUTINE S00490(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00090,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 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 C00090(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(23)
      RWN=RWN+1
      ENTRY=C00090(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)*(1  -C00096(SSMP(SSMPST(22)-1+
     *  I00001),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+I00001)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(I00002-
     *  1))
        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(46),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 "tfd"',
     *  ' in equation "INTDEMANDFS"',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,
     *  C00090,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 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 C00090(SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(21)
      DO     3 I00001=1,SSZ(23)
      RWN=RWN+1
      ENTRY=C00090(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)*C00096(SSMP(SSMPST(22)-1+
     *  I00001),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+
     *  I00004))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+I00001)+SSZ(5)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+SSMP(SSMPST(20)-1+I00004)))-1+SSZ(10)*(I00002-
     *  1))
        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(46),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 "tfm"',
     *  ' in equation "INTDEMANDFS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00491')
      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''',
     *    'PURCHPRICELSTK',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00440(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,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 S00441(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,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 S00442(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),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(85),ECHO1,
     *  ROWBF(41),COLBF(85),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(21),SSZ(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 S00444(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(98),KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00445(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(99),KZC,DOEQ,STRHS,STRHNZ,
     *  C00268,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(41),COLBF(100),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(21),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00447(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,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 S00449(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'INTDEMANDNONL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00450(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,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 S00451(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,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 S00452(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 S00453(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(84),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 S00455(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(98),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00456(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(99),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00457(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(100),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00458(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,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 S00460(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'INTDEMANDNONF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00461(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,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 S00462(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,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 S00463(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 S00464(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(84),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 S00466(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(98),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00467(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(99),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00468(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(100),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00469(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,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 S00471(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'FSDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00472(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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,
     *  C00089,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(86),ECHO1,
     *  ROWBF(44),COLBF(86),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''',
     *    'FSPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00476(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00091,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 S00477(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00091,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(85),ECHO1,
     *  ROWBF(45),COLBF(85),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 S00479(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00091,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 S00480(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00091,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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'INTDEMANDFS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00481(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00090,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 S00482(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00090,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 S00483(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 S00484(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  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(86),ECHO1,
     *  ROWBF(46),COLBF(86),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 S00486(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(98),KZC,DOEQ,STRHS,STRHNZ,
     *  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 S00487(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(99),KZC,DOEQ,STRHS,STRHNZ,
     *  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 S00488(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(100),KZC,DOEQ,STRHS,STRHNZ,
     *  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 S00489(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  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 S00490(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00090,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 S00491(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00090,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
      RETURN
15000 CALL PERET('M00015')
      RETURN
      END
      SUBROUTINE S00495(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 "AGRPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       15)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(15)
      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(9)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "AGRPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00495')
      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 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 "tf"',
     *  ' in equation "AGRPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tf',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 I00004=1,SSZ(15)
      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(9)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),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 "tf"',
     *  ' in equation "AGRPFACTPRICE"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 "NAGRPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       15)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(16)
      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(9)*(SSMP(SSMPST(13)-1+
     *  I00004)-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "NAGRPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00498')
      RETURN
      END
      SUBROUTINE S00500(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 "tf"',
     *  ' in equation "NAGRPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tf',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 I00004=1,SSZ(16)
      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(9)*(SSMP(SSMPST(13)-1+
     *  I00004)-1+SSZ(10)*(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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),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 "tf"',
     *  ' in equation "NAGRPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00500')
      RETURN
      END
      SUBROUTINE S00501(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(       15)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(9)*(I00004-1+SSZ(10)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00501')
      RETURN
      END
      SUBROUTINE S00503(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 "tf"',
     *  ' 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''',
     *    'tf',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 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(9)*(I00004-1+SSZ(10)*
     *  (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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(50),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 "tf"',
     *  ' in equation "SPFACTPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00503')
      RETURN
      END
      SUBROUTINE S00504(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00280,C00281,C00282,
     *  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 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 C00280(SSZ(15),SSZ(1))
      REAL C00281(SSZ(16),SSZ(1))
      REAL C00282(SSZ(10),SSZ(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 "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''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=C00280(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),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 I00004=1,SSZ(16)
      ENTRY=C00281(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(13)-1+I00004))+SSZ(12)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),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 5 I00004=1,SSZ(10)
      ENTRY=C00282(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00004)+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),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(53),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00504')
      RETURN
      END
      SUBROUTINE S00505(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00283,C00284,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 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 C00283(SSZ(15),SSZ(1))
      REAL C00284(SSZ(16),SSZ(1))
      REAL C00285(SSZ(10),SSZ(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 "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''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       14)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=C00283(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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 I00004=1,SSZ(16)
      ENTRY=C00284(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(13)-1+I00004))+SSZ(12)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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 5 I00004=1,SSZ(10)
      ENTRY=C00285(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00004)+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(53),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00505')
      RETURN
      END
      SUBROUTINE S00506(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00095,C00286,C00287,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 I00004
      INTEGER I00007
      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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00286(SSZ(9),SSZ(15),SSZ(1))
      REAL C00287(SSZ(9),SSZ(16),SSZ(1))
      REAL C00288(SSZ(9),SSZ(10),SSZ(1))
      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 "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''',
     *    'pfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       15)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(15)
      DO 3 I00001=1,SSZ(28)
      ENTRY=C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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(15)
      DO 5 I00007=1,SSZ(9)
      ENTRY=C00286(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
      DO 8 I00004=1,SSZ(16)
      DO 7 I00001=1,SSZ(28)
      ENTRY=C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*C00095(SSMP(SSMPST(13)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(13)-1+
     *  I00004)-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
    7 CONTINUE
    8 CONTINUE
      DO 10 I00004=1,SSZ(16)
      DO 9 I00007=1,SSZ(9)
      ENTRY=C00287(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(13)-1+I00004)-1+SSZ(10)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
    9 CONTINUE
   10 CONTINUE
      DO 12 I00004=1,SSZ(10)
      DO 11 I00001=1,SSZ(27)
      ENTRY=C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*
     *  C00095(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(9)*(I00004-1+SSZ(10)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
   11 CONTINUE
   12 CONTINUE
      DO 14 I00004=1,SSZ(10)
      DO 13 I00007=1,SSZ(9)
      ENTRY=C00288(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(I00004-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
   13 CONTINUE
   14 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(53),COLBF(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfe"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00506')
      RETURN
      END
      SUBROUTINE S00509(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00048(SSZ(9),SSZ(10),SSZ(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(       23)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(10)
      DO 2 I00001=1,SSZ(27)
      ENTRY=-C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(27)*(I00004-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),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(53),COLBF(23),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00509')
      RETURN
      END
      SUBROUTINE S00511(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 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 C00038(SSZ(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(       48)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00038(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(48),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(53),COLBF(48),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00511')
      RETURN
      END
      SUBROUTINE S00512(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00291,C00292,C00293,
     *  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 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 C00291(SSZ(15),SSZ(1))
      REAL C00292(SSZ(16),SSZ(1))
      REAL C00293(SSZ(10),SSZ(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 "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''',
     *    'aosec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       88)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=C00291(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(88),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 I00004=1,SSZ(16)
      ENTRY=C00292(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00004)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(88),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 5 I00004=1,SSZ(10)
      ENTRY=C00293(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(88),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(53),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
    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 "aosec"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00512')
      RETURN
      END
      SUBROUTINE S00514(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00291,C00292,C00293,
     *  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 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 C00291(SSZ(15),SSZ(1))
      REAL C00292(SSZ(16),SSZ(1))
      REAL C00293(SSZ(10),SSZ(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 "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''',
     *    'aoall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       90)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=C00291(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))+SSZ(10)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(90),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 I00004=1,SSZ(16)
      ENTRY=C00292(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00004)+SSZ(10)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(90),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 5 I00004=1,SSZ(10)
      ENTRY=C00293(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(10)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(90),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(53),COLBF(90),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "aoall"',
     *  ' in equation "TFURATIO"',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,
     *  C00291,C00292,C00293,
     *  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 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 C00291(SSZ(15),SSZ(1))
      REAL C00292(SSZ(16),SSZ(1))
      REAL C00293(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "avasec"',
     *  ' 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''',
     *    'avasec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=C00291(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),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 I00004=1,SSZ(16)
      ENTRY=C00292(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00004)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),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 5 I00004=1,SSZ(10)
      ENTRY=C00293(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),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(53),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "avasec"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00515')
      RETURN
      END
      SUBROUTINE S00517(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,
     *  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 C00030(SSZ(11),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tf"',
     *  ' 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''',
     *    'tf',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 I00004=1,SSZ(10)
      DO 3 I00001=1,SSZ(28)
      ENTRY=-C00030(SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  I00001)),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(I00004-1+SSZ(10)*
     *  (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 I00004=1,SSZ(10)
      DO 5 I00001=1,SSZ(27)
      ENTRY=-C00030(SSMP(SSMPST(6)-1+SSMP(SSMPST(26)-1+
     *  I00001)),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(9)*(I00004-1+SSZ(10)*
     *  (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(53),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 "tf"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00517')
      RETURN
      END
      SUBROUTINE S00518(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00295,C00296,C00297,
     *  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 I00007
      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 C00295(SSZ(9),SSZ(1))
      REAL C00296(SSZ(28),SSZ(1))
      REAL C00297(SSZ(27),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afecom"',
     *  ' 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''',
     *    'afecom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      105)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(9)
      ENTRY=C00295(I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(28)
      ENTRY=C00296(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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 5 I00001=1,SSZ(27)
      ENTRY=C00297(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(53),COLBF(105),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afecom"',
     *  ' in equation "TFURATIO"',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,
     *  C00298,C00299,C00300,
     *  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 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 C00298(SSZ(15),SSZ(1))
      REAL C00299(SSZ(16),SSZ(1))
      REAL C00300(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afesec"',
     *  ' 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''',
     *    'afesec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=C00298(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),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 I00004=1,SSZ(16)
      ENTRY=C00299(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00004)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),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 5 I00004=1,SSZ(10)
      ENTRY=C00300(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),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(53),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afesec"',
     *  ' in equation "TFURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00519')
      RETURN
      END
      SUBROUTINE S00521(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00095,C00302,C00303,C00304,
     *  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 I00007
      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 C00048(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00302(SSZ(9),SSZ(15),SSZ(1))
      REAL C00303(SSZ(9),SSZ(16),SSZ(1))
      REAL C00304(SSZ(9),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afeall"',
     *  ' 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''',
     *    'afeall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(15)
      DO 3 I00007=1,SSZ(9)
      ENTRY=C00302(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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(15)
      DO 5 I00001=1,SSZ(28)
      ENTRY=-C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
      DO 8 I00004=1,SSZ(16)
      DO 7 I00007=1,SSZ(9)
      ENTRY=C00303(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(13)-1+I00004)-1+SSZ(10)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    7 CONTINUE
    8 CONTINUE
      DO 10 I00004=1,SSZ(16)
      DO 9 I00001=1,SSZ(28)
      ENTRY=-C00048(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-1.0+C00095(SSMP(SSMPST(13)-1+I00004),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(13)-1+
     *  I00004)-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    9 CONTINUE
   10 CONTINUE
      DO 12 I00004=1,SSZ(10)
      DO 11 I00007=1,SSZ(9)
      ENTRY=C00304(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(I00004-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
   11 CONTINUE
   12 CONTINUE
      DO 14 I00004=1,SSZ(10)
      DO 13 I00001=1,SSZ(27)
      ENTRY=-C00048(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*(-1.0+
     *  C00095(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(9)*(I00004-1+SSZ(10)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
   13 CONTINUE
   14 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(53),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afeall"',
     *  ' in equation "TFURATIO"',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,
     *  C00274,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00274(SSZ(5),SSZ(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(5)
      ENTRY=C00274(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(57),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('S00522')
      RETURN
      END
      SUBROUTINE S00526(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 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 C00038(SSZ(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(       47)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00038(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(47),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(57),COLBF(47),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00526')
      RETURN
      END
      SUBROUTINE S00528(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00046,C00056,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 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 C00019(SSZ(5),SSZ(10),SSZ(1))
      REAL C00046(SSZ(5),SSZ(10),SSZ(1))
      REAL C00056(SSZ(5))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' 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''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(10)
      DO 2 I00001=1,SSZ(5)
      ENTRY=-(C00019(I00001,I00004,I00002)+C00046(I00001,I00004,I00002)*
     *  C00056(I00001)*(1  -C00096(I00001,I00004,I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00002-1))
        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
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(57),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00528')
      RETURN
      END
      SUBROUTINE S00529(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00020,C00046,C00056,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 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 C00020(SSZ(5),SSZ(10),SSZ(1))
      REAL C00046(SSZ(5),SSZ(10),SSZ(1))
      REAL C00056(SSZ(5))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' 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''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(10)
      DO 2 I00001=1,SSZ(5)
      ENTRY=-(C00020(I00001,I00004,I00002)-C00046(I00001,I00004,I00002)*
     *  (-C00056(I00001)*C00096(I00001,I00004,I00002)+C00056(I00001)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00002-1))
        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
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(57),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "TIURATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00529')
      RETURN
      END
      SUBROUTINE S00530(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,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 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 C00056(SSZ(5))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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(10)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00056(I00001)-C00056(I00001)*(1  -
     *  C00096(I00001,I00004,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(60),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('S00530')
      RETURN
      END
      SUBROUTINE S00531(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,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 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 C00056(SSZ(5))
      REAL C00096(SSZ(5),SSZ(10),SSZ(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 "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''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        8)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00056(I00001)*C00096(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "INDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00531')
      RETURN
      END
      SUBROUTINE S00534(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,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 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 C00056(SSZ(5))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' 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''',
     *    'tfd',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 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00056(I00001)*(1  -C00096(I00001,I00004,I00003))+
     *  C00056(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00003-1))
        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(60),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 "tfd"',
     *  ' in equation "INDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00534')
      RETURN
      END
      SUBROUTINE S00535(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,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 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 C00056(SSZ(5))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' 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''',
     *    'tfm',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 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00056(I00001)*C00096(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00003-1))
        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(60),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 "tfm"',
     *  ' in equation "INDDOM"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00535')
      RETURN
      END
      SUBROUTINE S00536(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 "OUTPUTSUB"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       41)
      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(10)-1+I00001)+SSZ(12)*(I00002-1)
        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(61),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "OUTPUTSUB"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00536')
      RETURN
      END
      SUBROUTINE S00537(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 "ato"',
     *  ' in equation "OUTPUTSUB"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      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(10)-1+I00001)+SSZ(12)*(I00002-1)
        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(61),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
    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 "ato"',
     *  ' in equation "OUTPUTSUB"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00537')
      RETURN
      END
      SUBROUTINE S00538(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(10)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(12)*(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(62),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('S00538')
      RETURN
      END
      SUBROUTINE S00539(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(       13)
      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(10)-1+I00001)+SSZ(12)*(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(62),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 "ps"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00539')
      RETURN
      END
      SUBROUTINE S00540(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 "ato"',
     *  ' 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''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      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(10)-1+I00001)+SSZ(12)*(I00002-1)
        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(62),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
    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 "ato"',
     *  ' in equation "OUTPUTPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00540')
      RETURN
      END
      SUBROUTINE S00541(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00050(SSZ(12),SSZ(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(10)
      ENTRY=-C00050(SSMP(SSMPST(10)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(12)*(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(63),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('S00541')
      RETURN
      END
      SUBROUTINE S00542(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00050(SSZ(12),SSZ(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(       14)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(10)
      ENTRY=-C00050(SSMP(SSMPST(10)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(63),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00542')
      RETURN
      END
      SUBROUTINE S00544(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 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 C00038(SSZ(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(       49)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00038(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(63),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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('S00544')
      RETURN
      END
      SUBROUTINE S00545(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00031(SSZ(12),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ato"',
     *  ' 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''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(10)
      ENTRY=C00031(SSMP(SSMPST(10)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(12)*(I00002-1)
        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
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(63),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ato"',
     *  ' in equation "TOUTRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00545')
      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''',
     *    'tfeqn',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(102),ECHO1,
     *  ROWBF(47),COLBF(102),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(103),ECHO1,
     *  ROWBF(47),COLBF(103),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(104),ECHO1,
     *  ROWBF(47),COLBF(104),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''',
     *    'AGRPFACTPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00495(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),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(21),ECHO1,
     *  ROWBF(48),COLBF(21),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 S00497(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),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''',
     *    'NAGRPFACTPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00498(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),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(22),ECHO1,
     *  ROWBF(49),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 S00500(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),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 S00501(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),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(23),ECHO1,
     *  ROWBF(50),COLBF(23),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 S00503(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),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''',
     *    'TFURATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00504(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00280,C00281,C00282,
     *  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 S00505(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00283,C00284,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 S00506(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00095,C00286,C00287,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(21),ECHO1,
     *  ROWBF(53),COLBF(21),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),SSZ(1),1,1,1,1,1,C00289,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(53),COLBF(22),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),SSZ(1),1,1,1,1,1,C00290,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00509(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(53),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00049,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00511(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(48),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 S00512(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00291,C00292,C00293,
     *  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(89),ECHO1,
     *  ROWBF(53),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00294,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00514(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00291,C00292,C00293,
     *  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 S00515(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(91),KZC,DOEQ,STRHS,STRHNZ,
     *  C00291,C00292,C00293,
     *  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(92),ECHO1,
     *  ROWBF(53),COLBF(92),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00294,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00517(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(102),KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,
     *  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 S00518(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(105),KZC,DOEQ,STRHS,STRHNZ,
     *  C00295,C00296,C00297,
     *  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 S00519(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00298,C00299,C00300,
     *  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(107),ECHO1,
     *  ROWBF(53),COLBF(107),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 S00521(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00095,C00302,C00303,C00304,
     *  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 S00522(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00274,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(8),ECHO1,
     *  ROWBF(57),COLBF(8),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00275,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(18),ECHO1,
     *  ROWBF(57),COLBF(18),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(10),SSZ(1),1,1,1,1,C00045,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(57),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00047,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00526(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(47),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(78),ECHO1,
     *  ROWBF(57),COLBF(78),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(10),SSZ(1),1,1,1,1,C00046,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00528(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00046,C00056,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 S00529(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00020,C00046,C00056,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
      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 S00530(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,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 S00531(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(18),ECHO1,
     *  ROWBF(60),COLBF(18),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(78),ECHO1,
     *  ROWBF(60),COLBF(78),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 S00534(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,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 S00535(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'OUTPUTSUB',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(41),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 S00537(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),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''',
     *    'OUTPUTPRICES',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00538(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 S00539(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),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 S00540(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),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 S00541(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00542(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(63),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00051,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00544(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(49),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 S00545(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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('M00016')
      RETURN
      END
      SUBROUTINE S00546(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00096,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 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 C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00097(SSZ(11),SSZ(10),SSZ(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 "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''',
     *    '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(10)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(5)
      ENTRY=-C00097(SSMP(SSMPST(7)-1+I00001),I00004,I00002)*(1  -
     *  C00096(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(64),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 "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00546')
      RETURN
      END
      SUBROUTINE S00547(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00096,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 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 C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00097(SSZ(11),SSZ(10),SSZ(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 "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''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        8)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(5)
      ENTRY=-C00097(SSMP(SSMPST(7)-1+I00001),I00004,I00002)*
     *  C00096(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(64),COLBF(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00547')
      RETURN
      END
      SUBROUTINE S00548(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(       13)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00004)+SSZ(12)*(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(64),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 "ps"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00548')
      RETURN
      END
      SUBROUTINE S00549(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 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 C00097(SSZ(11),SSZ(10),SSZ(1))
      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 "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''',
     *    'pfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       15)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(9)
      ENTRY=-C00097(SSMP(SSMPST(6)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(9)*(I00004-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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(64),COLBF(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfe"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00549')
      RETURN
      END
      SUBROUTINE S00555(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 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 C00097(SSZ(11),SSZ(10),SSZ(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(       98)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(5)
      ENTRY=C00097(SSMP(SSMPST(7)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(64),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
    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('S00555')
      RETURN
      END
      SUBROUTINE S00558(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 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 C00097(SSZ(11),SSZ(10),SSZ(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(      101)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(5)
      ENTRY=C00097(SSMP(SSMPST(7)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(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(64),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 "afall"',
     *  ' in equation "ZEROPROFITS"',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,
     *  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 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 C00097(SSZ(11),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afecom"',
     *  ' 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''',
     *    'afecom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      105)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(9)
      ENTRY=C00097(SSMP(SSMPST(6)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(64),COLBF(105),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afecom"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00559')
      RETURN
      END
      SUBROUTINE S00562(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 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 C00097(SSZ(11),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afeall"',
     *  ' 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''',
     *    'afeall',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)
      DO     2 I00004=1,SSZ(10)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(9)
      ENTRY=C00097(SSMP(SSMPST(6)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(9)*(I00004-1+SSZ(10)*(I00002-1))
        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(64),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 "afeall"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00562')
      RETURN
      END
      SUBROUTINE S00563(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00096,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 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 C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00097(SSZ(11),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' 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''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(5)
      ENTRY=-C00097(SSMP(SSMPST(7)-1+I00001),I00004,I00002)*(1  -
     *  C00096(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00002-1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(64),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
    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 "tfd"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00563')
      RETURN
      END
      SUBROUTINE S00564(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00096,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 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 C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00097(SSZ(11),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' 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''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(5)
      ENTRY=-C00097(SSMP(SSMPST(7)-1+I00001),I00004,I00002)*
     *  C00096(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00002-1))
        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(64),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 "tfm"',
     *  ' in equation "ZEROPROFITS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00564')
      RETURN
      END
      SUBROUTINE S00566(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 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,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 C00031(SSZ(12),SSZ(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(       14)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00007=1,SSZ(29)
      RS1=RS1+C00031(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(29)-
     *  1+I00007))),I00002)
    2 CONTINUE
      DO 3 I00006=1,SSZ(29)
      RS2=-C00031(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(29)-1+
     *  I00006))),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(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(29)-1+
     *  I00006)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(65),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00566')
      RETURN
      END
      SUBROUTINE S00568(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 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,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 C00031(SSZ(12),SSZ(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(       13)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=0.0
      DO 2 I00007=1,SSZ(29)
      RS1=RS1+C00031(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(29)-
     *  1+I00007))),I00002)
    2 CONTINUE
      DO 3 I00006=1,SSZ(29)
      RS2=-C00031(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(29)-1+
     *  I00006))),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(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(29)-1+
     *  I00006)))+SSZ(12)*(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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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('S00568')
      RETURN
      END
      SUBROUTINE S00570(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00057,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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,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(12),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 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(       14)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00006=1,SSZ(8)
      RS1=-C00031(SSMP(SSMPST(10)-1+SSMP(SSMPST(5)-1+I00006)),I00002)
      RS2=C00057(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(10)-1+SSMP(SSMPST(5)-1+I00006))+SSZ(12)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(67),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00570')
      RETURN
      END
      SUBROUTINE S00572(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00057,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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,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(12),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 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(       13)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00006=1,SSZ(8)
      RS1=-C00031(SSMP(SSMPST(10)-1+SSMP(SSMPST(5)-1+I00006)),I00002)
      RS2=C00057(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(10)-1+SSMP(SSMPST(5)-1+I00006))+SSZ(12)*
     *  (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
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(68),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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('S00572')
      RETURN
      END
      SUBROUTINE S00576(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 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 C00099(SSZ(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(       24)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-(1.0-C00099(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(24),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(24),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00576')
      RETURN
      END
      SUBROUTINE S00586(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(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(29)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(29)-1+
     *  I00001)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(73),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00586')
      RETURN
      END
      SUBROUTINE S00589(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,C00058,C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00024(SSZ(1))
      REAL C00058(SSZ(1))
      INTEGER C00102(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(       24)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=-(1  -C00102(1))*C00024(I00002)
      RS2=C00058(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(24),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(74),COLBF(24),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00589')
      RETURN
      END
      SUBROUTINE S00590(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00102(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(       43)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-(1  -C00102(1))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        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(74),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 "globalcgds"',
     *  ' in equation "RORGLOBAL"',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,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00102(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(      115)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00102(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(74),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 "rore"',
     *  ' in equation "RORGLOBAL"',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,
     *  C00057,C00058,C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00057(SSZ(1))
      REAL C00058(SSZ(1))
      INTEGER C00102(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(      117)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      RS1=(1  -C00102(1))*C00057(I00002)
      RS2=C00058(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(117),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(74),COLBF(117),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00592')
      RETURN
      END
      SUBROUTINE S00593(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00102(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(      120)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00102(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(120),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(74),COLBF(120),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00593')
      RETURN
      END
      SUBROUTINE S00595(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,C00059,C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00024(SSZ(1))
      REAL C00059(1)
      INTEGER C00102(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(       24)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=C00102(1)*C00024(I00002)
      RS2=C00059(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(24),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(75),COLBF(24),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00595')
      RETURN
      END
      SUBROUTINE S00596(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00102(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(       43)
      RWN=RWN+1
      ENTRY=C00102(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        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(75),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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('S00596')
      RETURN
      END
      SUBROUTINE S00597(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00058(SSZ(1))
      REAL C00059(1)
      INTEGER C00102(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(      115)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=-(1  -C00102(1))*C00058(I00002)
      RS2=C00059(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(115),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(75),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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('S00597')
      RETURN
      END
      SUBROUTINE S00598(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00057,C00059,C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00057(SSZ(1))
      REAL C00059(1)
      INTEGER C00102(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(      117)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=-C00102(1)*C00057(I00002)
      RS2=C00059(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(117),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(75),COLBF(117),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00598')
      RETURN
      END
      SUBROUTINE S00599(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00102(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(      120)
      RWN=RWN+1
      ENTRY=1  -C00102(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(120),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(75),COLBF(120),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00599')
      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''',
     *    'ZEROPROFITS',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(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00096,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 S00547(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00096,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 S00548(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),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 S00549(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),KZC,DOEQ,STRHS,STRHNZ,
     *  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(88),ECHO1,
     *  ROWBF(64),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(64),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(64),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(91),ECHO1,
     *  ROWBF(64),COLBF(91),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(10),SSZ(1),1,1,1,1,1,C00265,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(64),COLBF(92),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(10),SSZ(1),1,1,1,1,1,C00265,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00555(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(98),KZC,DOEQ,STRHS,STRHNZ,
     *  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(99),ECHO1,
     *  ROWBF(64),COLBF(99),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(10),SSZ(1),1,1,1,1,1,C00269,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(100),ECHO1,
     *  ROWBF(64),COLBF(100),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(10),SSZ(1),1,1,1,1,1,C00269,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00558(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(101),KZC,DOEQ,STRHS,STRHNZ,
     *  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 S00559(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(105),KZC,DOEQ,STRHS,STRHNZ,
     *  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(106),ECHO1,
     *  ROWBF(64),COLBF(106),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(10),SSZ(1),1,1,1,1,1,C00279,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(107),ECHO1,
     *  ROWBF(64),COLBF(107),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(10),SSZ(1),1,1,1,1,1,C00279,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00562(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  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 S00563(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00096,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 S00564(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00096,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(112),ECHO1,
     *  ROWBF(64),COLBF(112),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''',
     *    'KAPSVCES',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00566(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(65),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
      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 S00568(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(113),ECHO1,
     *  ROWBF(66),COLBF(113),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 S00570(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00057,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(117),ECHO1,
     *  ROWBF(67),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''',
     *    'PRCGOODS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00572(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00057,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(25),ECHO1,
     *  ROWBF(68),COLBF(25),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(24),ECHO1,
     *  ROWBF(69),COLBF(24),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(118),ECHO1,
     *  ROWBF(69),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
      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 S00576(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(24),KZC,DOEQ,STRHS,STRHNZ,
     *  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(114),ECHO1,
     *  ROWBF(70),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(117),ECHO1,
     *  ROWBF(70),COLBF(117),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00099,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(25),ECHO1,
     *  ROWBF(71),COLBF(25),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00100,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(113),ECHO1,
     *  ROWBF(71),COLBF(113),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00100,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(71),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
      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(24),ECHO1,
     *  ROWBF(72),COLBF(24),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00101,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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,
     *  SSZ(1),1,1,1,1,1,1,C00101,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(72),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(116),ECHO1,
     *  ROWBF(72),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
      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 S00586(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),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(117),ECHO1,
     *  ROWBF(73),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(119),ECHO1,
     *  ROWBF(73),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
      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 S00589(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(24),KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,C00058,C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00590(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(43),KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(115),KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(117),KZC,DOEQ,STRHS,STRHNZ,
     *  C00057,C00058,C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00593(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(120),KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(121),ECHO1,
     *  ROWBF(74),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
      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 S00595(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(24),KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,C00059,C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(43),KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(115),KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(117),KZC,DOEQ,STRHS,STRHNZ,
     *  C00057,C00059,C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(120),KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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('M00017')
      RETURN
      END
      SUBROUTINE S00600(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00058(SSZ(1))
      REAL C00059(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(       25)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)
      RS1=-C00058(I00002)
      RS2=C00059(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(25),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(76),COLBF(25),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00600')
      RETURN
      END
      SUBROUTINE S00603(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00058,C00059,
     *  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 C00008(SSZ(1))
      REAL C00058(SSZ(1))
      REAL C00059(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(       25)
      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(25),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=-(C00058(I00003)-C00008(I00003))
      RS2=C00059(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(25),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(77),COLBF(25),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00603')
      RETURN
      END
      SUBROUTINE S00605(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(5),SSZ(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(5)
      ENTRY=C00328(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(79),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('S00605')
      RETURN
      END
      SUBROUTINE S00608(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 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 C00038(SSZ(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(       50)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00038(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(50),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(50),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00608')
      RETURN
      END
      SUBROUTINE S00610(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00028,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 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 C00028(SSZ(5),SSZ(1),SSZ(1))
      REAL C00052(SSZ(5),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(      124)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(5)
      ENTRY=-(-C00028(I00001,I00002,I00003)-
     *  C00052(I00001,I00002,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1+SSZ(1)*(I00003-1))
        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
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),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 "txs"',
     *  ' in equation "TEXPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00610')
      RETURN
      END
      SUBROUTINE S00611(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00103,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 I00001
      INTEGER I00003
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00103(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(5)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(1)
      ENTRY=-C00103(I00001,I00007,I00003)*C00116(I00001,I00007,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (I00007-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(81),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('S00611')
      RETURN
      END
      SUBROUTINE S00614(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00103,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 I00001
      INTEGER I00003
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00103(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      123)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(1)
      ENTRY=C00103(I00001,I00007,I00003)*C00116(I00001,I00007,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00007-1)
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(81),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
    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('S00614')
      RETURN
      END
      SUBROUTINE S00615(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00103,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 I00001
      INTEGER I00003
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00103(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      124)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(1)
      ENTRY=C00103(I00001,I00007,I00003)*C00116(I00001,I00007,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00007-1+SSZ(1)*(I00003-1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(81),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
    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('S00615')
      RETURN
      END
      SUBROUTINE S00618(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00349,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  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 C00349(SSZ(6),SSZ(5),SSZ(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(      130)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(6)
      ENTRY=C00349(I00005,I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(130),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(81),COLBF(130),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00618')
      RETURN
      END
      SUBROUTINE S00620(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00103,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 I00001
      INTEGER I00003
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00103(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),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(      132)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(1)
      ENTRY=C00103(I00001,I00007,I00003)*C00348(I00001,I00007,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(132),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(81),COLBF(132),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00620')
      RETURN
      END
      SUBROUTINE S00623(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(5)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(82),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('S00623')
      RETURN
      END
      SUBROUTINE S00626(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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 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 C00104(SSZ(5))
      REAL C00116(SSZ(5),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(5)
      RWN=RWN+1
      ENTRY=C00104(I00001)*C00116(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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
    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('S00626')
      RETURN
      END
      SUBROUTINE S00630(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 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 C00104(SSZ(5))
      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(       82)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-(-1.0+C00104(I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1+SSZ(1)*(I00003-1))
        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(83),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 "ams"',
     *  ' in equation "IMPORTDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00630')
      RETURN
      END
      SUBROUTINE S00631(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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 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 C00104(SSZ(5))
      REAL C00116(SSZ(5),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(      123)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00104(I00001)*C00116(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        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(83),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
    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('S00631')
      RETURN
      END
      SUBROUTINE S00632(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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 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 C00104(SSZ(5))
      REAL C00116(SSZ(5),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(      124)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00104(I00001)*C00116(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1+SSZ(1)*(I00003-1))
        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(83),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
    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('S00632')
      RETURN
      END
      SUBROUTINE S00635(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,C00114,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 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 C00104(SSZ(5))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),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(      130)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 4 I00005=1,SSZ(6)
      ENTRY=-C00104(I00001)*C00117(I00001,I00002,I00003)*
     *  C00114(I00005,I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(130),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(83),COLBF(130),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00635')
      RETURN
      END
      SUBROUTINE S00636(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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 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 C00104(SSZ(5))
      REAL C00348(SSZ(5),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(      131)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00104(I00001)*C00348(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        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(83),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
    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('S00636')
      RETURN
      END
      SUBROUTINE S00637(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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 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 C00104(SSZ(5))
      REAL C00348(SSZ(5),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(      132)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00104(I00001)*C00348(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(132),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(132),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00637')
      RETURN
      END
      SUBROUTINE S00638(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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 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 C00104(SSZ(5))
      REAL C00348(SSZ(5),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(      133)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00104(I00001)*C00348(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00003
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(133),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(133),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00638')
      RETURN
      END
      SUBROUTINE S00639(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,C00114,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 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 C00104(SSZ(5))
      REAL C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),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(      137)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 4 I00005=1,SSZ(6)
      ENTRY=C00104(I00001)*C00117(I00001,I00002,I00003)*
     *  C00114(I00005,I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(137),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(83),COLBF(137),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00639')
      RETURN
      END
      SUBROUTINE S00640(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,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 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 C00054(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(5)
      ENTRY=-C00054(I00001,I00003,I00002)*C00116(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(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 "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00640')
      RETURN
      END
      SUBROUTINE S00643(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 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 C00038(SSZ(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(       51)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00038(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(51),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(51),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00643')
      RETURN
      END
      SUBROUTINE S00644(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,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 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 C00054(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      123)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(5)
      ENTRY=C00054(I00001,I00003,I00002)*C00116(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1)
        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
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(84),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 "tx"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00644')
      RETURN
      END
      SUBROUTINE S00645(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,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 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 C00054(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      124)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00001=1,SSZ(5)
      ENTRY=C00054(I00001,I00003,I00002)*C00116(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1+SSZ(1)*(I00002-1))
        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
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(84),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 "txs"',
     *  ' in equation "TIMPRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00645')
      RETURN
      END
      SUBROUTINE S00648(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00353,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00353(SSZ(6),SSZ(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(      130)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(6)
      ENTRY=C00353(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(130),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(130),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00648')
      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''',
     *    'PRICGDS',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(25),KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(76),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
      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(77),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 S00603(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(25),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00058,C00059,
     *  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(122),ECHO1,
     *  ROWBF(77),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
      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 S00605(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(27),ECHO1,
     *  ROWBF(79),COLBF(27),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),SSZ(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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(31),ECHO1,
     *  ROWBF(79),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,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 S00608(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(50),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(123),ECHO1,
     *  ROWBF(79),COLBF(123),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00329,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00610(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00028,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''',
     *    'DPRICEIMP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00611(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00103,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(8),ECHO1,
     *  ROWBF(81),COLBF(8),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(82),ECHO1,
     *  ROWBF(81),COLBF(82),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),SSZ(1),1,1,1,1,C00103,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00103,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00615(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00103,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(125),ECHO1,
     *  ROWBF(81),COLBF(125),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00343,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(81),COLBF(126),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),SSZ(1),1,1,1,1,C00103,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00618(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(130),KZC,DOEQ,STRHS,STRHNZ,
     *  C00349,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(131),ECHO1,
     *  ROWBF(81),COLBF(131),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00620(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(132),KZC,DOEQ,STRHS,STRHNZ,
     *  C00103,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(133),ECHO1,
     *  ROWBF(81),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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(137),ECHO1,
     *  ROWBF(81),COLBF(137),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(5),SSZ(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
      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 S00623(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(8),ECHO1,
     *  ROWBF(82),COLBF(8),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(127),ECHO1,
     *  ROWBF(82),COLBF(127),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 S00626(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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(8),ECHO1,
     *  ROWBF(83),COLBF(8),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00104,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(27),ECHO1,
     *  ROWBF(83),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(83),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00630(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00631(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00632(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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(125),ECHO1,
     *  ROWBF(83),COLBF(125),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00104,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(83),COLBF(126),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00104,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00635(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(130),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,C00114,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 S00636(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(131),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00637(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(132),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00638(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(133),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00639(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(137),KZC,DOEQ,STRHS,STRHNZ,
     *  C00104,C00114,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''',
     *    'TIMPRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00640(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,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(27),ECHO1,
     *  ROWBF(84),COLBF(27),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),SSZ(1),1,1,1,1,C00054,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(84),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00055,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00643(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(51),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 S00644(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00645(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00054,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(125),ECHO1,
     *  ROWBF(84),COLBF(125),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00352,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(84),COLBF(126),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),SSZ(1),1,1,1,1,C00025,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00648(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(130),KZC,DOEQ,STRHS,STRHNZ,
     *  C00353,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(131),ECHO1,
     *  ROWBF(84),COLBF(131),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(132),ECHO1,
     *  ROWBF(84),COLBF(132),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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(133),ECHO1,
     *  ROWBF(84),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00356,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(84),COLBF(137),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),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
      RETURN
15000 CALL PERET('M00018')
      RETURN
      END
      SUBROUTINE S00654(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 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(6))
      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(      130)
      DO     1 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=C00344(I00005)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(130),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(130),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00654')
      RETURN
      END
      SUBROUTINE S00659(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00112,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00112(SSZ(6),SSZ(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(6)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      ENTRY=-C00112(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(12)*(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(87),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('S00659')
      RETURN
      END
      SUBROUTINE S00661(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(6)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(12)*(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(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
    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('S00661')
      RETURN
      END
      SUBROUTINE S00665(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 "INCOMETAX"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       41)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(9)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(12)*
     *  (I00002-1)
        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(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
    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 "INCOMETAX"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 "ato"',
     *  ' in equation "INCOMETAX"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(9)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(12)*
     *  (I00002-1)
        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(92),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
    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 "ato"',
     *  ' in equation "INCOMETAX"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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(9)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(12)*
     *  (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(93),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('S00668')
      RETURN
      END
      SUBROUTINE S00669(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(       13)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(9)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(12)*
     *  (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(93),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 "ps"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00669')
      RETURN
      END
      SUBROUTINE S00670(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 "ato"',
     *  ' 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''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(9)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(12)*
     *  (I00002-1)
        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(93),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
    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 "ato"',
     *  ' in equation "FACTORINCPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00670')
      RETURN
      END
      SUBROUTINE S00671(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00050(SSZ(12),SSZ(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(9)
      ENTRY=-C00050(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(12)*
     *  (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(94),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('S00671')
      RETURN
      END
      SUBROUTINE S00672(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00050(SSZ(12),SSZ(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(       14)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(9)
      ENTRY=-C00050(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(12)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00672')
      RETURN
      END
      SUBROUTINE S00674(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 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 C00038(SSZ(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(       52)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100.0 *C00038(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(94),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 "del_taxrinc"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00674')
      RETURN
      END
      SUBROUTINE S00675(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00031(SSZ(12),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ato"',
     *  ' 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''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(9)
      ENTRY=C00031(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(12)*
     *  (I00002-1)
        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
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(94),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "ato"',
     *  ' in equation "TINCRATIO"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00675')
      RETURN
      END
      SUBROUTINE S00676(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(27)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(26)-1+
     *  I00001)))+SSZ(12)*(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(95),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('S00676')
      RETURN
      END
      SUBROUTINE S00677(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 I00001
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(9),SSZ(10),SSZ(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(       23)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(27)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(10)
      ENTRY=-C00119(SSMP(SSMPST(26)-1+I00001),I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(27)*(I00007-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),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(95),COLBF(23),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00677')
      RETURN
      END
      SUBROUTINE S00678(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(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 "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(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=-C00120(SSMP(SSMPST(26)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(26)-1+
     *  I00001)))+SSZ(12)*(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(96),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('S00678')
      RETURN
      END
      SUBROUTINE S00679(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(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(26)-1+
     *  I00001)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00679')
      RETURN
      END
      SUBROUTINE S00680(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(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 "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(       23)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=C00120(SSMP(SSMPST(26)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(27)*(I00004-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),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(23),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00680')
      RETURN
      END
      SUBROUTINE S00682(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(       34)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(34),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(34),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00682')
      RETURN
      END
      SUBROUTINE S00683(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00033(SSZ(12),SSZ(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(9)
      ENTRY=-C00033(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(12)*
     *  (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(97),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('S00683')
      RETURN
      END
      SUBROUTINE S00684(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00033(SSZ(12),SSZ(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(       14)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(9)
      ENTRY=-C00033(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(12)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00684')
      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''',
     *    '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(27),ECHO1,
     *  ROWBF(86),COLBF(27),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(5),SSZ(1),SSZ(1),1,1,1,C00111,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00654(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(130),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(131),ECHO1,
     *  ROWBF(86),COLBF(131),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(5),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(132),ECHO1,
     *  ROWBF(86),COLBF(132),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),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(133),ECHO1,
     *  ROWBF(86),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(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(136),ECHO1,
     *  ROWBF(86),COLBF(136),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 S00659(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00112,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(137),ECHO1,
     *  ROWBF(87),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''',
     *    'TRANSVCES',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00661(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(30),ECHO1,
     *  ROWBF(90),COLBF(30),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(136),ECHO1,
     *  ROWBF(90),COLBF(136),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(90),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''',
     *    'INCOMETAX',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(41),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 S00666(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),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(138),ECHO1,
     *  ROWBF(92),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
      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 S00668(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 S00669(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),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 S00670(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),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 S00671(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00672(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(94),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00118,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00674(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(52),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 S00675(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00676(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 S00677(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(23),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''',
     *    'ENDW_SUPPLY',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(5),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 S00679(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),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 S00680(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(23),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(33),ECHO1,
     *  ROWBF(96),COLBF(33),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 S00682(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(34),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''',
     *    'FACTORINCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00683(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(24),ECHO1,
     *  ROWBF(97),COLBF(24),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00024,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(25),ECHO1,
     *  ROWBF(97),COLBF(25),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00024,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(97),COLBF(139),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00121,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(45),ECHO1,
     *  ROWBF(98),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(46),ECHO1,
     *  ROWBF(98),COLBF(46),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(47),ECHO1,
     *  ROWBF(98),COLBF(47),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(98),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(98),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(50),ECHO1,
     *  ROWBF(98),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(51),ECHO1,
     *  ROWBF(98),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(140),ECHO1,
     *  ROWBF(98),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''',
     *    '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(45),ECHO1,
     *  ROWBF(99),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(46),ECHO1,
     *  ROWBF(99),COLBF(46),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(47),ECHO1,
     *  ROWBF(99),COLBF(47),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(99),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(99),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(50),ECHO1,
     *  ROWBF(99),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(51),ECHO1,
     *  ROWBF(99),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(99),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(141),ECHO1,
     *  ROWBF(99),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
      RETURN
15000 CALL PERET('M00019')
      RETURN
      END
      SUBROUTINE S00705(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00038,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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(1))
      REAL C00122(SSZ(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(       31)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00038(I00002)-C00122(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(100),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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('S00705')
      RETURN
      END
      SUBROUTINE S00707(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 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 C00038(SSZ(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(      140)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-100.0 *C00038(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(140),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(100),COLBF(140),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00707')
      RETURN
      END
      SUBROUTINE S00738(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(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(109),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00738')
      RETURN
      END
      SUBROUTINE S00739(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00128(SSZ(5),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(       27)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00128(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  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(109),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 "qxs"',
     *  ' in equation "MKTCLTRD_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00739')
      RETURN
      END
      SUBROUTINE S00741(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00126,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00126(SSZ(5),SSZ(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(      150)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-C00126(SSMP(SSMPST(2)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(150),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(109),COLBF(150),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00741')
      RETURN
      END
      SUBROUTINE S00742(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(      151)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(151),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(109),COLBF(151),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00742')
      RETURN
      END
      SUBROUTINE S00743(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(       14)
      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(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(3)-1+
     *  I00001)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(110),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00743')
      RETURN
      END
      SUBROUTINE S00744(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00128(SSZ(5),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(       27)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00128(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  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(110),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 "qxs"',
     *  ' in equation "MKTCLTRD_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00744')
      RETURN
      END
      SUBROUTINE S00745(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00126,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00126(SSZ(5),SSZ(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(      150)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=-C00126(SSMP(SSMPST(3)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(150),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(110),COLBF(150),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00745')
      RETURN
      END
      SUBROUTINE S00746(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(      151)
      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(3)-1+I00001)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(151),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(110),COLBF(151),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00746')
      RETURN
      END
      SUBROUTINE S00747(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,C00132,C00276,
     *  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 I00016
      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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00132(SSZ(5),SSZ(1))
      REAL C00276(SSZ(5),SSZ(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(5)
      RWN=RWN+1
      ENTRY=C00276(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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 I00016=1,SSZ(5)
      RS1=-C00132(I00001,I00002)*C00034(I00016,I00002)
      RS2=C00035(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00061(I00016,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00016))+SSZ(12)*
     *  (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(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
    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('S00747')
      RETURN
      END
      SUBROUTINE S00748(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,C00132,C00277,
     *  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 I00016
      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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00132(SSZ(5),SSZ(1))
      REAL C00277(SSZ(5),SSZ(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(        8)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00277(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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 I00016=1,SSZ(5)
      RS1=-C00132(I00001,I00002)*C00034(I00016,I00002)
      RS2=C00035(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00061(I00016,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00016+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(111),COLBF(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00748')
      RETURN
      END
      SUBROUTINE S00752(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,C00131,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00056(SSZ(5))
      REAL C00131(SSZ(5),SSZ(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(       57)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00131(I00001,I00002)*C00056(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(57),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(111),COLBF(57),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pp"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00752')
      RETURN
      END
      SUBROUTINE S00754(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,C00131,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00056(SSZ(5))
      REAL C00131(SSZ(5),SSZ(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(       74)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00131(I00001,I00002)*C00056(I00001)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(74),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(111),COLBF(74),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00754')
      RETURN
      END
      SUBROUTINE S00756(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,C00096,C00130,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00056(SSZ(5))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00130(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' 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''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(10)
      ENTRY=-C00130(I00001,I00004,I00002)*C00056(I00001)*(1  -
     *  C00096(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00002-1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(111),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
    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 "tfd"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00756')
      RETURN
      END
      SUBROUTINE S00757(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,C00096,C00130,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00056(SSZ(5))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL C00130(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' 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''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(10)
      ENTRY=C00130(I00001,I00004,I00002)*(-C00056(I00001)*
     *  C00096(I00001,I00004,I00002)+C00056(I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00002-1))
        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(111),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 "tfm"',
     *  ' in equation "MKTCLIMP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00757')
      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''',
     *    'REGIONALINCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00705(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00038,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(139),ECHO1,
     *  ROWBF(100),COLBF(139),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00121,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00707(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(140),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(142),ECHO1,
     *  ROWBF(100),COLBF(142),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00038,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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''',
     *    'PRIVUTILITY',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(40),ECHO1,
     *  ROWBF(101),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(143),ECHO1,
     *  ROWBF(101),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(101),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GOVUTILITY',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(37),ECHO1,
     *  ROWBF(102),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(143),ECHO1,
     *  ROWBF(102),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(145),ECHO1,
     *  ROWBF(102),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''',
     *    'SAVUTILITY',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(2),ECHO1,
     *  ROWBF(103),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(32),ECHO1,
     *  ROWBF(103),COLBF(32),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(103),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(146),ECHO1,
     *  ROWBF(103),COLBF(146),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_YPRATIO',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(104),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(39),ECHO1,
     *  ROWBF(104),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(147),ECHO1,
     *  ROWBF(104),COLBF(147),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_YGRATIO',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(105),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(36),ECHO1,
     *  ROWBF(105),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(148),ECHO1,
     *  ROWBF(105),COLBF(148),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_YSRATIO',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(106),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(106),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(31),ECHO1,
     *  ROWBF(106),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(149),ECHO1,
     *  ROWBF(106),COLBF(149),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''',
     *    'REGUTILITY',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(107),COLBF(1),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00008,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(107),COLBF(2),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00008,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(107),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00038,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(36),ECHO1,
     *  ROWBF(107),COLBF(36),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00035,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(107),COLBF(39),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00037,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(108),COLBF(4),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00125,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(10),ECHO1,
     *  ROWBF(108),COLBF(10),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00124,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(18),ECHO1,
     *  ROWBF(108),COLBF(18),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(10),SSZ(1),1,1,1,1,C00123,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(108),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''',
     *    'MKTCLTRD_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00738(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),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 S00739(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(30),ECHO1,
     *  ROWBF(109),COLBF(30),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(1),1,1,1,1,1,C00127,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00741(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(150),KZC,DOEQ,STRHS,STRHNZ,
     *  C00126,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00742(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(151),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''',
     *    'MKTCLTRD_NMRG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00743(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),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 S00744(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00745(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(150),KZC,DOEQ,STRHS,STRHNZ,
     *  C00126,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00746(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(151),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 S00747(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,C00132,C00276,
     *  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 S00748(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,C00132,C00277,
     *  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(32),ECHO1,
     *  ROWBF(111),COLBF(32),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00132,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(111),COLBF(37),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00132,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(111),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00752(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(57),KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,C00131,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(58),ECHO1,
     *  ROWBF(111),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00754(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(74),KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,C00131,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(78),ECHO1,
     *  ROWBF(111),COLBF(78),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(10),SSZ(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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00756(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,C00096,C00130,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00757(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00056,C00096,C00130,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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('M00020')
      RETURN
      END
      SUBROUTINE S00758(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(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 "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       13)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)))+SSZ(12)*(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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(112),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 "ps"',
     *  ' in equation "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00758')
      RETURN
      END
      SUBROUTINE S00759(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(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 "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(112),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "MKTCLENDWAGR"',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,
     *  C00021,C00086,C00094,C00095,
     *  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 I00007
      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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      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 "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       15)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(15)
      ENTRY=C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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 6 I00004=1,SSZ(15)
      DO 5 I00007=1,SSZ(9)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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(112),COLBF(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfe"',
     *  ' in equation "MKTCLENDWAGR"',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,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(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 "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       88)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00086(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(112),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
    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 "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00761')
      RETURN
      END
      SUBROUTINE S00763(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(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 "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       90)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00086(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))+SSZ(10)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(90),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(112),COLBF(90),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "aoall"',
     *  ' in equation "MKTCLENDWAGR"',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,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "avasec"',
     *  ' in equation "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'avasec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00086(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),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(112),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "avasec"',
     *  ' in equation "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00764')
      RETURN
      END
      SUBROUTINE S00766(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00306,C00307,
     *  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 I00007
      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 C00306(SSZ(28),SSZ(9),SSZ(1))
      REAL C00307(SSZ(28),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afecom"',
     *  ' in equation "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afecom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      105)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 4 I00007=1,SSZ(9)
      ENTRY=C00306(I00001,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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=C00307(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(112),COLBF(105),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afecom"',
     *  ' in equation "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00766')
      RETURN
      END
      SUBROUTINE S00767(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,C00095,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afesec"',
     *  ' in equation "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afesec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(15)
      ENTRY=C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*((-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*C00278(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)-(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),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(112),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afesec"',
     *  ' in equation "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00767')
      RETURN
      END
      SUBROUTINE S00769(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,C00094,C00095,
     *  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 I00007
      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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afeall"',
     *  ' in equation "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afeall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 5 I00004=1,SSZ(15)
      DO 4 I00007=1,SSZ(9)
      ENTRY=C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-C00086(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    5 CONTINUE
      DO 6 I00004=1,SSZ(15)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(112),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afeall"',
     *  ' in equation "MKTCLENDWAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00769')
      RETURN
      END
      SUBROUTINE S00772(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(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 "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       13)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(16)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*C00086(SSMP(SSMPST(13)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(13)-1+I00004))+SSZ(12)*
     *  (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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(113),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 "ps"',
     *  ' in equation "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00772')
      RETURN
      END
      SUBROUTINE S00773(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(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 "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(16)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(13)-1+I00004))+SSZ(12)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(113),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00773')
      RETURN
      END
      SUBROUTINE S00774(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,C00094,C00095,
     *  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 I00007
      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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      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 "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       15)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(16)
      ENTRY=C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*C00095(SSMP(SSMPST(13)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(13)-1+
     *  I00004)-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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 6 I00004=1,SSZ(16)
      DO 5 I00007=1,SSZ(9)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-C00086(SSMP(SSMPST(13)-1+I00004),I00002)+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002))*
     *  C00094(I00007,SSMP(SSMPST(13)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(13)-1+I00004)-1+SSZ(10)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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(113),COLBF(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfe"',
     *  ' in equation "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00774')
      RETURN
      END
      SUBROUTINE S00775(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(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 "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       88)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(16)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-1.0+C00086(SSMP(SSMPST(13)-1+I00004),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00004)
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(113),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
    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 "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00775')
      RETURN
      END
      SUBROUTINE S00777(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(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 "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       90)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(16)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-1.0+C00086(SSMP(SSMPST(13)-1+I00004),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00004)+SSZ(10)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(90),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(113),COLBF(90),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "aoall"',
     *  ' in equation "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00777')
      RETURN
      END
      SUBROUTINE S00778(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "avasec"',
     *  ' in equation "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'avasec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(16)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-1.0+C00086(SSMP(SSMPST(13)-1+I00004),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00004)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),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(113),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "avasec"',
     *  ' in equation "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00778')
      RETURN
      END
      SUBROUTINE S00780(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00310,C00311,
     *  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 I00007
      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 C00310(SSZ(28),SSZ(9),SSZ(1))
      REAL C00311(SSZ(28),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afecom"',
     *  ' in equation "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afecom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      105)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 4 I00007=1,SSZ(9)
      ENTRY=C00310(I00001,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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=C00311(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(113),COLBF(105),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afecom"',
     *  ' in equation "MKTCLENDWNAGR"',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,
     *  C00021,C00086,C00095,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afesec"',
     *  ' in equation "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afesec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 3 I00004=1,SSZ(16)
      ENTRY=C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*((-C00086(SSMP(SSMPST(13)-1+I00004),I00002)+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002))*
     *  C00278(SSMP(SSMPST(13)-1+I00004),I00002)-(-1.0+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(13)-1+I00004)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),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(113),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afesec"',
     *  ' in equation "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00781')
      RETURN
      END
      SUBROUTINE S00783(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,C00094,C00095,
     *  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 I00007
      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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afeall"',
     *  ' in equation "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afeall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00001=1,SSZ(28)
      RWN=RWN+1
      DO 5 I00004=1,SSZ(16)
      DO 4 I00007=1,SSZ(9)
      ENTRY=C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-C00086(SSMP(SSMPST(13)-1+I00004),I00002)+
     *  C00095(SSMP(SSMPST(13)-1+I00004),I00002))*
     *  C00094(I00007,SSMP(SSMPST(13)-1+I00004),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(13)-1+I00004)-1+SSZ(10)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    5 CONTINUE
      DO 6 I00004=1,SSZ(16)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)*(-1.0+C00095(SSMP(SSMPST(13)-1+I00004),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(13)-1+
     *  I00004)-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(113),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afeall"',
     *  ' in equation "MKTCLENDWNAGR"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00783')
      RETURN
      END
      SUBROUTINE S00786(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00033(SSZ(12),SSZ(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 "ENDWAGRI_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(28)
      RWN=RWN+1
      ENTRY=C00033(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  I00001))),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  I00001)))+SSZ(12)*(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(114),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 "ENDWAGRI_PRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00786')
      RETURN
      END
      SUBROUTINE S00789(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00135,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00135(SSZ(28),SSZ(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 "ENDWAGR_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 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-C00135(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  I00001)))+SSZ(12)*(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(115),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 "ENDWAGR_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00789')
      RETURN
      END
      SUBROUTINE S00790(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 "ENDWAGR_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(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  I00001)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "ENDWAGR_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00790')
      RETURN
      END
      SUBROUTINE S00793(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00135,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00135(SSZ(28),SSZ(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 "ENDWNAGR_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 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-C00135(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  I00001)))+SSZ(12)*(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(116),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 "ENDWNAGR_SUPPLY"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 "ENDWNAGR_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(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(28)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  I00001)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "ENDWNAGR_SUPPLY"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00794')
      RETURN
      END
      SUBROUTINE S00797(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(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 "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''',
     *    'ps',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 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=-C00086(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00004)+SSZ(12)*(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(117),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
    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 "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00797')
      RETURN
      END
      SUBROUTINE S00798(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 "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''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       14)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00004)+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00798')
      RETURN
      END
      SUBROUTINE S00799(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,
     *  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 I00007
      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 C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      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 "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''',
     *    'pfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       15)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(10)
      DO     4 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=C00095(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(9)*(I00004-1+SSZ(10)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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 5 I00007=1,SSZ(9)
      ENTRY=-(-C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00094(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(I00004-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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(117),COLBF(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfe"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00799')
      RETURN
      END
      SUBROUTINE S00801(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(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 "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''',
     *    'aosec',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(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        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(117),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 "aosec"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00801')
      RETURN
      END
      SUBROUTINE S00802(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(1))
      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 "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''',
     *    'aoreg',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(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        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(117),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 "aoreg"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00802')
      RETURN
      END
      SUBROUTINE S00803(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(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 "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''',
     *    'aoall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       90)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(10)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(90),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(90),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00803')
      RETURN
      END
      SUBROUTINE S00804(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "avasec"',
     *  ' 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''',
     *    'avasec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),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(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "avasec"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00804')
      RETURN
      END
      SUBROUTINE S00805(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "avareg"',
     *  ' 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''',
     *    'avareg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       92)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=-(-1.0+C00086(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),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(92),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "avareg"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00805')
      RETURN
      END
      SUBROUTINE S00806(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,
     *  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 I00007
      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 C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afecom"',
     *  ' 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''',
     *    'afecom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      105)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(10)
      DO     4 I00001=1,SSZ(27)
      RWN=RWN+1
      DO 5 I00007=1,SSZ(9)
      ENTRY=(-C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00094(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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
    5 CONTINUE
      ENTRY=-(-1.0+C00095(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(105),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afecom"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00806')
      RETURN
      END
      SUBROUTINE S00807(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00095,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afesec"',
     *  ' 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''',
     *    'afesec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=(-C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00278(I00004,I00002)-(-1.0+C00095(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),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(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afesec"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00807')
      RETURN
      END
      SUBROUTINE S00808(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00095,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00086(SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afereg"',
     *  ' 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''',
     *    'afereg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      107)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00004=1,SSZ(10)
      DO     3 I00001=1,SSZ(27)
      RWN=RWN+1
      ENTRY=(-C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00278(I00004,I00002)-(-1.0+C00095(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),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(107),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afereg"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00808')
      RETURN
      END
      SUBROUTINE S00809(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,
     *  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 I00007
      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 C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afeall"',
     *  ' 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''',
     *    'afeall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      DO     3 I00004=1,SSZ(10)
      DO     4 I00001=1,SSZ(27)
      RWN=RWN+1
      DO 5 I00007=1,SSZ(9)
      ENTRY=(-C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00094(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(I00004-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    5 CONTINUE
      ENTRY=-(-1.0+C00095(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(9)*(I00004-1+SSZ(10)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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(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
    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 "afeall"',
     *  ' in equation "MKTCLENDWS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00809')
      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''',
     *    'MKTCLENDWAGR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00758(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00759(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(15),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,C00094,C00095,
     *  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 S00761(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(89),ECHO1,
     *  ROWBF(112),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),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 S00763(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(91),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(112),COLBF(92),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),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 S00766(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(105),KZC,DOEQ,STRHS,STRHNZ,
     *  C00306,C00307,
     *  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 S00767(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,C00095,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(107),ECHO1,
     *  ROWBF(112),COLBF(107),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00769(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,C00094,C00095,
     *  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(152),ECHO1,
     *  ROWBF(112),COLBF(152),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),SSZ(1),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(153),ECHO1,
     *  ROWBF(112),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLENDWNAGR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00772(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00773(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00774(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,C00094,C00095,
     *  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 S00775(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(89),ECHO1,
     *  ROWBF(113),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00777(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00778(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(91),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(113),COLBF(92),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00780(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(105),KZC,DOEQ,STRHS,STRHNZ,
     *  C00310,C00311,
     *  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 S00781(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,C00095,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(107),ECHO1,
     *  ROWBF(113),COLBF(107),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00783(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00086,C00094,C00095,
     *  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(154),ECHO1,
     *  ROWBF(113),COLBF(154),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),SSZ(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(155),ECHO1,
     *  ROWBF(113),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ENDWAGRI_PRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00786(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(21),ECHO1,
     *  ROWBF(114),COLBF(21),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),SSZ(1),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
      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(28),SSZ(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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ENDWAGR_SUPPLY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00789(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00135,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00790(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),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(21),ECHO1,
     *  ROWBF(115),COLBF(21),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),SSZ(1),1,1,1,1,1,C00135,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(115),COLBF(152),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''',
     *    'ENDWNAGR_SUPPLY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00793(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00135,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(14),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(22),ECHO1,
     *  ROWBF(116),COLBF(22),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),SSZ(1),1,1,1,1,1,C00135,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(116),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLENDWS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00797(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00798(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),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 S00799(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,
     *  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(33),ECHO1,
     *  ROWBF(117),COLBF(33),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 S00801(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00802(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00803(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00804(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(91),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00805(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(92),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00806(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(105),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,
     *  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 S00807(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00095,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00808(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00095,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00809(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,
     *  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
      RETURN
15000 CALL PERET('M00021')
      RETURN
      END
      SUBROUTINE S00819(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00033(SSZ(12),SSZ(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(9)
      ENTRY=-C00033(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(12)*
     *  (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(122),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('S00819')
      RETURN
      END
      SUBROUTINE S00823(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00029,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 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 C00029(SSZ(6),SSZ(1))
      REAL C00330(SSZ(5),SSZ(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(5)
      ENTRY=C00330(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(6)
      ENTRY=-C00029(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(12)*(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(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
    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('S00823')
      RETURN
      END
      SUBROUTINE S00827(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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 I00001
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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 I00007=1,SSZ(1)
      DO 2 I00001=1,SSZ(5)
      ENTRY=-C00026(I00001,I00007,I00002)*C00116(I00001,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (I00007-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(125),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('S00827')
      RETURN
      END
      SUBROUTINE S00828(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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 I00001
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      123)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(1)
      DO 2 I00001=1,SSZ(5)
      ENTRY=C00026(I00001,I00007,I00002)*C00116(I00001,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00007-1)
        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
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(125),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 "tx"',
     *  ' in equation "REGDEMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00828')
      RETURN
      END
      SUBROUTINE S00829(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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 I00001
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      124)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(1)
      DO 2 I00001=1,SSZ(5)
      ENTRY=C00026(I00001,I00007,I00002)*C00116(I00001,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00007-1+SSZ(1)*(I00002-1))
        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
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(125),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 "txs"',
     *  ' in equation "REGDEMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00829')
      RETURN
      END
      SUBROUTINE S00830(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00358,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00358(SSZ(6),SSZ(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(      130)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(6)
      ENTRY=C00358(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(130),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(125),COLBF(130),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00830')
      RETURN
      END
      SUBROUTINE S00839(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00029,C00116,C00332,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00116(SSZ(5),SSZ(1),SSZ(1))
      REAL C00332(SSZ(5),SSZ(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(6)
      ENTRY=-C00029(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(12)*(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(5)
      ENTRY=C00332(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(5)
      ENTRY=C00026(I00001,I00003,I00002)*C00116(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(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
    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('S00839')
      RETURN
      END
      SUBROUTINE S00840(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00260,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00061(SSZ(5),SSZ(1))
      REAL C00260(SSZ(5),SSZ(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(        8)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(5)
      ENTRY=C00260(I00001,I00002)*C00061(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00840')
      RETURN
      END
      SUBROUTINE S00842(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00027,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00027(SSZ(5),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(       27)
      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(5)
      ENTRY=-C00027(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),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(5)
      ENTRY=C00026(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),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(127),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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('S00842')
      RETURN
      END
      SUBROUTINE S00849(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00116,C00333,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),SSZ(1),SSZ(1))
      REAL C00333(SSZ(5),SSZ(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(      123)
      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(5)
      ENTRY=-C00026(I00001,I00003,I00002)*C00116(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),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(5)
      ENTRY=C00333(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),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(127),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
    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('S00849')
      RETURN
      END
      SUBROUTINE S00850(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00027,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 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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      124)
      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(5)
      ENTRY=-C00026(I00001,I00003,I00002)*C00116(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(124),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(5)
      ENTRY=C00027(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(124),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(127),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
    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('S00850')
      RETURN
      END
      SUBROUTINE S00851(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00363,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00363(SSZ(6),SSZ(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(      130)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(6)
      ENTRY=C00363(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(130),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(130),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00851')
      RETURN
      END
      SUBROUTINE S00857(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00029,C00116,C00334,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00029(SSZ(6),SSZ(1))
      REAL C00116(SSZ(5),SSZ(1),SSZ(1))
      REAL C00334(SSZ(5),SSZ(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(5)
      ENTRY=C00334(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(6)
      ENTRY=-C00029(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(12)*(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(5)
      ENTRY=C00026(I00001,I00003,I00002)*C00116(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(128),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('S00857')
      RETURN
      END
      SUBROUTINE S00858(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00061,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00034(SSZ(5),SSZ(1))
      REAL C00061(SSZ(5),SSZ(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(        8)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(5)
      ENTRY=-C00034(I00001,I00002)*C00061(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(128),COLBF(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00858')
      RETURN
      END
      SUBROUTINE S00861(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00116,C00333,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),SSZ(1),SSZ(1))
      REAL C00333(SSZ(5),SSZ(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(      123)
      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(5)
      ENTRY=-C00026(I00001,I00003,I00002)*C00116(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),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(5)
      ENTRY=C00333(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(123),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(128),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
    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('S00861')
      RETURN
      END
      SUBROUTINE S00862(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00027,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 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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      124)
      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(5)
      ENTRY=-C00026(I00001,I00003,I00002)*C00116(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(124),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(5)
      ENTRY=C00027(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(124),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(128),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
    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('S00862')
      RETURN
      END
      SUBROUTINE S00863(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00363,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00363(SSZ(6),SSZ(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(      130)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00005=1,SSZ(6)
      ENTRY=C00363(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(130),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(128),COLBF(130),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00863')
      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''',
     *    '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(43),ECHO1,
     *  ROWBF(118),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(44),ECHO1,
     *  ROWBF(118),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(156),ECHO1,
     *  ROWBF(118),COLBF(156),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(119),COLBF(1),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00008,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(119),COLBF(2),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00008,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(119),COLBF(157),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00059,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(156),ECHO1,
     *  ROWBF(120),COLBF(156),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(157),ECHO1,
     *  ROWBF(120),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(158),ECHO1,
     *  ROWBF(120),COLBF(158),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 S00819(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(164),ECHO1,
     *  ROWBF(122),COLBF(164),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00140,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(164),ECHO1,
     *  ROWBF(123),COLBF(164),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00140,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(165),ECHO1,
     *  ROWBF(123),COLBF(165),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,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
      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 S00823(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00029,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(123),ECHO1,
     *  ROWBF(124),COLBF(123),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00331,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(124),COLBF(124),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),SSZ(1),1,1,1,1,C00027,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(124),COLBF(166),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00137,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00827(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00828(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00829(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00830(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(130),KZC,DOEQ,STRHS,STRHNZ,
     *  C00358,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(131),ECHO1,
     *  ROWBF(125),COLBF(131),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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(132),ECHO1,
     *  ROWBF(125),COLBF(132),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(133),ECHO1,
     *  ROWBF(125),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00361,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(125),COLBF(137),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),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(167),ECHO1,
     *  ROWBF(125),COLBF(167),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00139,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(166),ECHO1,
     *  ROWBF(126),COLBF(166),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(167),ECHO1,
     *  ROWBF(126),COLBF(167),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(168),ECHO1,
     *  ROWBF(126),COLBF(168),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''',
     *    'VGDP_r',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00839(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00029,C00116,C00332,
     *  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 S00840(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00260,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(25),ECHO1,
     *  ROWBF(127),COLBF(25),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 S00842(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00027,
     *  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(30),ECHO1,
     *  ROWBF(127),COLBF(30),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(1),1,1,1,1,1,C00029,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(32),ECHO1,
     *  ROWBF(127),COLBF(32),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(37),ECHO1,
     *  ROWBF(127),COLBF(37),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(57),ECHO1,
     *  ROWBF(127),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(58),ECHO1,
     *  ROWBF(127),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(117),ECHO1,
     *  ROWBF(127),COLBF(117),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 S00849(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00116,C00333,
     *  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 S00850(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00027,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 S00851(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(130),KZC,DOEQ,STRHS,STRHNZ,
     *  C00363,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(131),ECHO1,
     *  ROWBF(127),COLBF(131),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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(132),ECHO1,
     *  ROWBF(127),COLBF(132),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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(133),ECHO1,
     *  ROWBF(127),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00366,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(127),COLBF(137),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),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(169),ECHO1,
     *  ROWBF(127),COLBF(169),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00142,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00857(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00029,C00116,C00334,
     *  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(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00061,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(25),ECHO1,
     *  ROWBF(128),COLBF(25),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(57),ECHO1,
     *  ROWBF(128),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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 S00861(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00116,C00333,
     *  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 S00862(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00027,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 S00863(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(130),KZC,DOEQ,STRHS,STRHNZ,
     *  C00363,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(131),ECHO1,
     *  ROWBF(128),COLBF(131),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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(132),ECHO1,
     *  ROWBF(128),COLBF(132),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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(133),ECHO1,
     *  ROWBF(128),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00366,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(128),COLBF(137),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),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(170),ECHO1,
     *  ROWBF(128),COLBF(170),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00142,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00869(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00261,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00061(SSZ(5),SSZ(1))
      REAL C00261(SSZ(5),SSZ(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(5)
      ENTRY=C00261(I00001,I00002)*(1  -C00061(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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('S00869')
      RETURN
      END
      SUBROUTINE S00870(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00261,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00061(SSZ(5),SSZ(1))
      REAL C00261(SSZ(5),SSZ(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(        8)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(5)
      ENTRY=C00261(I00001,I00002)*C00061(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00870')
      RETURN
      END
      SUBROUTINE S00871(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00027,
     *  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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00027(SSZ(5),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(       27)
      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(5)
      ENTRY=-C00027(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),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(5)
      ENTRY=C00026(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),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(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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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('S00871')
      RETURN
      END
      SUBROUTINE S00878(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(6),SSZ(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(6)
      RWN=RWN+1
      ENTRY=C00335(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(12)*(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(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
    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('S00878')
      RETURN
      END
      SUBROUTINE S00879(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00027(SSZ(5),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(       27)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  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(131),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 "qxs"',
     *  ' in equation "VREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00879')
      RETURN
      END
      SUBROUTINE S00881(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 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 C00336(SSZ(6),SSZ(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(      123)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=C00336(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1)
        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(131),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
    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('S00881')
      RETURN
      END
      SUBROUTINE S00882(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00027(SSZ(5),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(      124)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(131),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
    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('S00882')
      RETURN
      END
      SUBROUTINE S00883(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00136(SSZ(5),SSZ(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(      159)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=C00136(SSMP(SSMPST(2)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(159),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(131),COLBF(159),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00883')
      RETURN
      END
      SUBROUTINE S00884(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(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 "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(7)
      RWN=RWN+1
      ENTRY=C00337(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(3)-1+
     *  I00001)))+SSZ(12)*(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(132),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('S00884')
      RETURN
      END
      SUBROUTINE S00885(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00027(SSZ(5),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(       27)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00027(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  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(132),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 "qxs"',
     *  ' in equation "VREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00885')
      RETURN
      END
      SUBROUTINE S00886(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00338,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00338(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 "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(      123)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=C00338(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1)
        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(132),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
    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('S00886')
      RETURN
      END
      SUBROUTINE S00887(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00027(SSZ(5),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(      124)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00027(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(132),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
    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('S00887')
      RETURN
      END
      SUBROUTINE S00888(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00136(SSZ(5),SSZ(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(      159)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=C00136(SSMP(SSMPST(3)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(159),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(132),COLBF(159),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00888')
      RETURN
      END
      SUBROUTINE S00895(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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 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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(5)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=-C00026(I00001,I00002,I00003)*C00116(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(136),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('S00895')
      RETURN
      END
      SUBROUTINE S00897(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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 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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      123)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00026(I00001,I00002,I00003)*C00116(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(136),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
    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('S00897')
      RETURN
      END
      SUBROUTINE S00898(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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 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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      124)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00026(I00001,I00002,I00003)*C00116(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1+SSZ(1)*(I00003-1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(136),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
    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('S00898')
      RETURN
      END
      SUBROUTINE S00899(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00368,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  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 C00368(SSZ(6),SSZ(5),SSZ(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(      130)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(6)
      ENTRY=C00368(I00005,I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(130),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(136),COLBF(130),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00899')
      RETURN
      END
      SUBROUTINE S00901(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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 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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),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(      132)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00026(I00001,I00002,I00003)*C00348(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(132),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(136),COLBF(132),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00901')
      RETURN
      END
      SUBROUTINE S00909(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00147(SSZ(5),SSZ(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(       14)
      DO     1 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      ENTRY=-C00147(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(139),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00909')
      RETURN
      END
      SUBROUTINE S00912(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,C00270,
     *  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 I00016
      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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00270(SSZ(5),SSZ(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(5)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00270(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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 I00016=1,SSZ(5)
      RS1=-C00034(I00001,I00003)*C00034(I00016,I00003)
      RS2=C00035(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00061(I00016,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00016))+SSZ(12)*
     *  (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(140),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('S00912')
      RETURN
      END
      SUBROUTINE S00913(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,C00271,
     *  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 I00016
      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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00061(SSZ(5),SSZ(1))
      REAL C00271(SSZ(5),SSZ(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(        8)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00271(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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 I00016=1,SSZ(5)
      RS1=-C00034(I00001,I00003)*C00034(I00016,I00003)
      RS2=C00035(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00061(I00016,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00016+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(140),COLBF(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00913')
      RETURN
      END
      SUBROUTINE S00918(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  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 C00030(SSZ(11),SSZ(10),SSZ(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(5)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(10)
      ENTRY=-C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(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(140),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('S00918')
      RETURN
      END
      SUBROUTINE S00919(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,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 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 C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' 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''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(10)
      ENTRY=-C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)*(1  -
     *  C00096(I00001,I00004,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00003-1))
        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
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(140),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "VWLDOUTUSE"',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,
     *  C00030,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 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 C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' 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''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(10)
      ENTRY=-C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)*
     *  C00096(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00003-1))
        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
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(140),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "VWLDOUTUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00920')
      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''',
     *    'QGDP_r',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00869(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00261,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00870(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00061,C00261,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00871(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00027,
     *  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(30),ECHO1,
     *  ROWBF(129),COLBF(30),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(1),1,1,1,1,1,C00029,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(32),ECHO1,
     *  ROWBF(129),COLBF(32),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(37),ECHO1,
     *  ROWBF(129),COLBF(37),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(58),ECHO1,
     *  ROWBF(129),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(117),ECHO1,
     *  ROWBF(129),COLBF(117),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(171),ECHO1,
     *  ROWBF(129),COLBF(171),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00142,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00878(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),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 S00879(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(30),ECHO1,
     *  ROWBF(131),COLBF(30),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(1),1,1,1,1,1,C00029,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00881(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),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 S00882(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(159),KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00884(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),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 S00885(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00886(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00338,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00887(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00888(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(159),KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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_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(159),ECHO1,
     *  ROWBF(133),COLBF(159),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00136,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(133),COLBF(161),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00137,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(159),ECHO1,
     *  ROWBF(134),COLBF(159),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00136,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(174),ECHO1,
     *  ROWBF(134),COLBF(174),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00143,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(161),ECHO1,
     *  ROWBF(135),COLBF(161),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00137,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(135),COLBF(175),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00144,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00895(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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(27),ECHO1,
     *  ROWBF(136),COLBF(27),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),SSZ(1),1,1,1,1,C00026,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00897(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00898(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00899(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(130),KZC,DOEQ,STRHS,STRHNZ,
     *  C00368,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(131),ECHO1,
     *  ROWBF(136),COLBF(131),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00901(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(132),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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(133),ECHO1,
     *  ROWBF(136),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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(137),ECHO1,
     *  ROWBF(136),COLBF(137),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(5),SSZ(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(160),ECHO1,
     *  ROWBF(136),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00138,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(160),ECHO1,
     *  ROWBF(137),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00138,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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,
     *  SSZ(1),1,1,1,1,1,1,C00139,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(160),ECHO1,
     *  ROWBF(138),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00138,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(138),COLBF(176),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00145,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00909(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(173),ECHO1,
     *  ROWBF(139),COLBF(173),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00147,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(139),COLBF(177),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00148,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00912(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,C00270,
     *  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 S00913(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,C00271,
     *  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(32),ECHO1,
     *  ROWBF(140),COLBF(32),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),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(37),ECHO1,
     *  ROWBF(140),COLBF(37),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),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(57),ECHO1,
     *  ROWBF(140),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(58),ECHO1,
     *  ROWBF(140),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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 S00918(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00919(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,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 S00920(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(178),ECHO1,
     *  ROWBF(140),COLBF(178),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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
      RETURN
15000 CALL PERET('M00023')
      RETURN
      END
      SUBROUTINE S00922(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(6),SSZ(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(6)
      RWN=RWN+1
      ENTRY=C00335(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(12)*(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(141),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('S00922')
      RETURN
      END
      SUBROUTINE S00923(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 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 C00336(SSZ(6),SSZ(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(      123)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=C00336(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1)
        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(141),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
    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('S00923')
      RETURN
      END
      SUBROUTINE S00924(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00027(SSZ(5),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(      124)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(141),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
    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('S00924')
      RETURN
      END
      SUBROUTINE S00925(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00136(SSZ(5),SSZ(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(      173)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=C00136(SSMP(SSMPST(2)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(173),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(141),COLBF(173),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00925')
      RETURN
      END
      SUBROUTINE S00926(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(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 "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(7)
      RWN=RWN+1
      ENTRY=C00337(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(3)-1+
     *  I00001)))+SSZ(12)*(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(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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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('S00926')
      RETURN
      END
      SUBROUTINE S00927(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00338,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00338(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 "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(      123)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=C00338(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1)
        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(142),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
    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('S00927')
      RETURN
      END
      SUBROUTINE S00928(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00027(SSZ(5),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(      124)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00027(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(142),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
    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('S00928')
      RETURN
      END
      SUBROUTINE S00929(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00136(SSZ(5),SSZ(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(      173)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=C00136(SSMP(SSMPST(3)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(173),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(142),COLBF(173),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00929')
      RETURN
      END
      SUBROUTINE S00936(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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 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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(5)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=-C00026(I00001,I00002,I00003)*C00116(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(146),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('S00936')
      RETURN
      END
      SUBROUTINE S00937(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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 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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      123)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00026(I00001,I00002,I00003)*C00116(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),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
    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('S00937')
      RETURN
      END
      SUBROUTINE S00938(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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 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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),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(      124)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00026(I00001,I00002,I00003)*C00116(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1+SSZ(1)*(I00003-1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),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
    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('S00938')
      RETURN
      END
      SUBROUTINE S00939(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00368,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  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 C00368(SSZ(6),SSZ(5),SSZ(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(      130)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00005=1,SSZ(6)
      ENTRY=C00368(I00005,I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(130),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(146),COLBF(130),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00939')
      RETURN
      END
      SUBROUTINE S00941(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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 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 C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),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(      132)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00026(I00001,I00002,I00003)*C00348(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(132),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(146),COLBF(132),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00941')
      RETURN
      END
      SUBROUTINE S00951(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00272,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  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 C00272(SSZ(5),SSZ(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(5)
      RWN=RWN+1
      DO 2 I00003=1,SSZ(1)
      ENTRY=C00272(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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(150),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('S00951')
      RETURN
      END
      SUBROUTINE S00954(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,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 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 C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' 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''',
     *    'tfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      109)
      DO     1 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(10)
      ENTRY=-C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)*(1  -
     *  C00096(I00001,I00004,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00003-1))
        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
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(150),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00954')
      RETURN
      END
      SUBROUTINE S00955(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,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 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 C00030(SSZ(11),SSZ(10),SSZ(1))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' 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''',
     *    'tfm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      110)
      DO     1 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(10)
      ENTRY=-C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)*
     *  C00096(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(I00003-1))
        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
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(150),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "PWLDUSE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00955')
      RETURN
      END
      SUBROUTINE S00957(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00027(SSZ(5),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(       27)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00027(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  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(151),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 "qxs"',
     *  ' in equation "QREGEX_ir_MARG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00957')
      RETURN
      END
      SUBROUTINE S00959(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00136(SSZ(5),SSZ(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(      187)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=C00136(SSMP(SSMPST(2)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(187),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(151),COLBF(187),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00959')
      RETURN
      END
      SUBROUTINE S00960(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00027(SSZ(5),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(       27)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=-C00027(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  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(152),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 "qxs"',
     *  ' in equation "QREGEX_ir_NMRG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00960')
      RETURN
      END
      SUBROUTINE S00961(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00136(SSZ(5),SSZ(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(      187)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=C00136(SSMP(SSMPST(3)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(187),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(152),COLBF(187),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00961')
      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''',
     *    'PREGEX_ir_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00922(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),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 S00923(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),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 S00924(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(173),KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00926(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),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 S00927(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00338,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00928(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00929(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(173),KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(173),ECHO1,
     *  ROWBF(143),COLBF(173),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00136,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(143),COLBF(179),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00137,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(173),ECHO1,
     *  ROWBF(144),COLBF(173),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00136,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(144),COLBF(180),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00143,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(179),ECHO1,
     *  ROWBF(145),COLBF(179),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00137,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(181),ECHO1,
     *  ROWBF(145),COLBF(181),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00144,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00936(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00937(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00938(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00939(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(130),KZC,DOEQ,STRHS,STRHNZ,
     *  C00368,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(131),ECHO1,
     *  ROWBF(146),COLBF(131),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00941(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(132),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,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(133),ECHO1,
     *  ROWBF(146),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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(137),ECHO1,
     *  ROWBF(146),COLBF(137),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(5),SSZ(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(182),ECHO1,
     *  ROWBF(146),COLBF(182),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00138,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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_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(182),ECHO1,
     *  ROWBF(147),COLBF(182),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00138,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(183),ECHO1,
     *  ROWBF(147),COLBF(183),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00139,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(182),ECHO1,
     *  ROWBF(148),COLBF(182),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00138,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(148),COLBF(184),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00145,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(173),ECHO1,
     *  ROWBF(149),COLBF(173),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00147,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(149),COLBF(185),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00148,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00951(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00272,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(8),ECHO1,
     *  ROWBF(150),COLBF(8),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00273,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(150),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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 S00954(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(109),KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,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 S00955(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(110),KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(186),ECHO1,
     *  ROWBF(150),COLBF(186),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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''',
     *    'QREGEX_ir_MARG',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(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(30),ECHO1,
     *  ROWBF(151),COLBF(30),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(1),1,1,1,1,1,C00029,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00959(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(187),KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00960(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00961(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(187),KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(187),ECHO1,
     *  ROWBF(153),COLBF(187),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00136,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(153),COLBF(188),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00137,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(187),ECHO1,
     *  ROWBF(154),COLBF(187),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00136,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(154),COLBF(189),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00143,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(188),ECHO1,
     *  ROWBF(155),COLBF(188),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00137,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(155),COLBF(190),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00144,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(27),ECHO1,
     *  ROWBF(156),COLBF(27),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),SSZ(1),1,1,1,1,C00026,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(156),COLBF(191),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00138,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(191),ECHO1,
     *  ROWBF(157),COLBF(191),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00138,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(157),COLBF(192),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00139,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00974(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00147(SSZ(5),SSZ(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(       14)
      DO     1 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 2 I00002=1,SSZ(1)
      ENTRY=-C00147(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(159),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00974')
      RETURN
      END
      SUBROUTINE S00976(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,
     *  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 I00016
      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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00061(SSZ(5),SSZ(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(5)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00034(I00001,I00003)*(1  -C00061(I00001,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001))+SSZ(12)*
     *  (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 I00016=1,SSZ(5)
      RS1=-C00034(I00001,I00003)*C00034(I00016,I00003)
      RS2=C00035(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*(1  -C00061(I00016,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00016))+SSZ(12)*
     *  (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(160),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('S00976')
      RETURN
      END
      SUBROUTINE S00977(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,
     *  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 I00016
      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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00061(SSZ(5),SSZ(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(        8)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00034(I00001,I00003)*C00061(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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 I00016=1,SSZ(5)
      RS1=-C00034(I00001,I00003)*C00034(I00016,I00003)
      RS2=C00035(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00061(I00016,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00016+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(8),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(160),COLBF(8),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00977')
      RETURN
      END
      SUBROUTINE S00981(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  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 C00030(SSZ(11),SSZ(10),SSZ(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(5)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      DO 2 I00004=1,SSZ(10)
      ENTRY=-C00030(SSMP(SSMPST(7)-1+I00001),I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00004-1+SSZ(10)*(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(160),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('S00981')
      RETURN
      END
      SUBROUTINE S00983(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00136(SSZ(5),SSZ(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(      159)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=-C00136(I00001,I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(159),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(161),COLBF(159),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00983')
      RETURN
      END
      SUBROUTINE S00984(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00138,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00138(SSZ(5),SSZ(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(      160)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(5)
      RWN=RWN+1
      ENTRY=C00138(I00001,I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(5)*(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(161),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 "viwcif"',
     *  ' in equation "TRADEBAL_i"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00984')
      RETURN
      END
      SUBROUTINE S00986(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00137,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00137(SSZ(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(      161)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-C00137(I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(161),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(162),COLBF(161),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00986')
      RETURN
      END
      SUBROUTINE S00987(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00139,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00139(SSZ(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(      162)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00139(I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(162),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(162),COLBF(162),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00987')
      RETURN
      END
      SUBROUTINE S00991(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 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 C00038(SSZ(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(      198)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=100*C00038(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(198),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(198),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00991')
      RETURN
      END
      SUBROUTINE S00992(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 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 C00339(SSZ(6),SSZ(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(6)
      RWN=RWN+1
      ENTRY=C00339(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(12)*(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(164),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('S00992')
      RETURN
      END
      SUBROUTINE S00993(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00340,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00340(SSZ(6),SSZ(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(      123)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=C00340(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1)
        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(164),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
    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('S00993')
      RETURN
      END
      SUBROUTINE S00994(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 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 C00156(SSZ(5),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(      124)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00156(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(164),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
    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('S00994')
      RETURN
      END
      SUBROUTINE S00995(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(      199)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(199),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(199),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00995')
      RETURN
      END
      SUBROUTINE S00996(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00341,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00341(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 "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(7)
      RWN=RWN+1
      ENTRY=C00341(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(3)-1+
     *  I00001)))+SSZ(12)*(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(165),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('S00996')
      RETURN
      END
      SUBROUTINE S00997(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00342,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00342(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 "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(      123)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      ENTRY=C00342(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1)
        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(165),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
    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('S00997')
      RETURN
      END
      SUBROUTINE S00998(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 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 C00156(SSZ(5),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(      124)
      DO     1 I00002=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00003=1,SSZ(1)
      ENTRY=C00156(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(165),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
    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('S00998')
      RETURN
      END
      SUBROUTINE S00999(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(      199)
      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(3)-1+I00001)+SSZ(5)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(199),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(165),COLBF(199),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S00999')
      RETURN
      END
      SUBROUTINE S01000(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00158(SSZ(5),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(6)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=-C00158(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005)))+SSZ(12)*(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(166),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('S01000')
      RETURN
      END
      SUBROUTINE S01001(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00158(SSZ(5),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(      123)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00158(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1)
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(166),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
    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('S01001')
      RETURN
      END
      SUBROUTINE S01002(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00158(SSZ(5),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(      124)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00158(SSMP(SSMPST(2)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(166),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
    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('S01002')
      RETURN
      END
      SUBROUTINE S01004(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(      200)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00005=1,SSZ(6)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00005)+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(200),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(200),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S01004')
      RETURN
      END
      SUBROUTINE S01005(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00158(SSZ(5),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(7)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=-C00158(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(3)-1+
     *  I00001)))+SSZ(12)*(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(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
    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('S01005')
      RETURN
      END
      SUBROUTINE S01006(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00158(SSZ(5),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(      123)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00158(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1)
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),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
    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('S01006')
      RETURN
      END
      SUBROUTINE S01007(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00158(SSZ(5),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(      124)
      DO     1 I00003=1,SSZ(1)
      DO     2 I00001=1,SSZ(7)
      RWN=RWN+1
      DO 3 I00002=1,SSZ(1)
      ENTRY=C00158(SSMP(SSMPST(3)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(3)-1+I00001)+SSZ(5)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        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
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(167),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
    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('S01007')
      RETURN
      END
      SUBROUTINE S01008(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(      200)
      DO     1 I00003=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(3)-1+I00001)+SSZ(5)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(200),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(200),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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('S01008')
      RETURN
      END
      SUBROUTINE S01013(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00151(SSZ(5),SSZ(1))
      REAL C00155(SSZ(5),SSZ(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_rEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      201)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00001=1,SSZ(5)
      ENTRY=-(C00151(I00001,I00002)-C00155(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(201),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(173),COLBF(201),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "px_i"',
     *  ' in equation "c1_rEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01013')
      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''',
     *    '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(191),ECHO1,
     *  ROWBF(158),COLBF(191),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00138,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(158),COLBF(193),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00145,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00974(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(194),ECHO1,
     *  ROWBF(159),COLBF(194),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,1,1,1,1,1,C00148,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00976(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,
     *  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 S00977(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(8),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00035,C00061,
     *  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(32),ECHO1,
     *  ROWBF(160),COLBF(32),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),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(37),ECHO1,
     *  ROWBF(160),COLBF(37),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),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(58),ECHO1,
     *  ROWBF(160),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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 S00981(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(78),KZC,DOEQ,STRHS,STRHNZ,
     *  C00030,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(195),ECHO1,
     *  ROWBF(160),COLBF(195),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),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''',
     *    'TRADEBAL_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00983(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(159),KZC,DOEQ,STRHS,STRHNZ,
     *  C00136,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00984(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(160),KZC,DOEQ,STRHS,STRHNZ,
     *  C00138,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(161),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''',
     *    'TRADEBALANCE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00986(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(161),KZC,DOEQ,STRHS,STRHNZ,
     *  C00137,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00987(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(162),KZC,DOEQ,STRHS,STRHNZ,
     *  C00139,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(197),ECHO1,
     *  ROWBF(162),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''',
     *    '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(31),ECHO1,
     *  ROWBF(163),COLBF(31),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(197),ECHO1,
     *  ROWBF(163),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00991(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(198),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
      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 S00992(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00993(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00340,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00994(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(124),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 S00995(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(199),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 S00996(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00341,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00342,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(124),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 S00999(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(199),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 S01000(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(137),ECHO1,
     *  ROWBF(166),COLBF(137),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(1),1,1,1,1,1,C00159,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01004(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(200),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 S01005(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(123),KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(124),KZC,DOEQ,STRHS,STRHNZ,
     *  C00158,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01008(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(200),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(199),ECHO1,
     *  ROWBF(168),COLBF(199),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00160,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(201),ECHO1,
     *  ROWBF(168),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''',
     *    '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(201),ECHO1,
     *  ROWBF(169),COLBF(201),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),1,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(202),ECHO1,
     *  ROWBF(169),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''',
     *    'c1_rEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01013(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(201),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(202),ECHO1,
     *  ROWBF(173),COLBF(202),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00371,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(206),ECHO1,
     *  ROWBF(173),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''',
     *    '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(199),ECHO1,
     *  ROWBF(174),COLBF(199),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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(201),ECHO1,
     *  ROWBF(174),COLBF(201),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(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(207),ECHO1,
     *  ROWBF(174),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''',
     *    '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(200),ECHO1,
     *  ROWBF(175),COLBF(200),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00155,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(201),ECHO1,
     *  ROWBF(175),COLBF(201),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(5),SSZ(1),1,1,1,1,1,C00155,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(208),ECHO1,
     *  ROWBF(175),COLBF(208),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 S01026(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00313,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00313(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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(13)
      ENTRY=C00313(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(26)-1+
     *  SSMP(SSMPST(28)-1+I00001))))+SSZ(12)*(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(177),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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01026')
      RETURN
      END
      SUBROUTINE S01027(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 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 C00314(SSZ(15),SSZ(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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       13)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00314(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)))+SSZ(12)*(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
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(177),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01027')
      RETURN
      END
      SUBROUTINE S01028(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00315,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00315(SSZ(15),SSZ(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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       14)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00315(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(177),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01028')
      RETURN
      END
      SUBROUTINE S01029(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00095,C00316,
     *  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 I00007
      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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00316(SSZ(9),SSZ(15),SSZ(1))
      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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       15)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(15)
      DO 3 I00001=1,SSZ(13)
      ENTRY=C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*
     *  C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+I00001))+SSZ(9)*
     *  (SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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(15)
      DO 5 I00007=1,SSZ(9)
      ENTRY=C00316(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
      DO 8 I00004=1,SSZ(15)
      DO 7 I00001=1,SSZ(28)
      ENTRY=C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
    7 CONTINUE
    8 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(177),COLBF(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfe"',
     *  ' in equation "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01029')
      RETURN
      END
      SUBROUTINE S01032(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00163,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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00163(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 "kb"',
     *  ' in equation "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       24)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-(-C00163(I00002)-C00171(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(24),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(177),COLBF(24),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01032')
      RETURN
      END
      SUBROUTINE S01033(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00163,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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00163(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 "pcgds"',
     *  ' in equation "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       25)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-(-C00163(I00002)-C00171(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(25),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(177),COLBF(25),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01033')
      RETURN
      END
      SUBROUTINE S01034(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 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 C00318(SSZ(15),SSZ(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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       88)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00318(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        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
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(177),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01034')
      RETURN
      END
      SUBROUTINE S01036(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 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 C00318(SSZ(15),SSZ(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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       90)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00318(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))+SSZ(10)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(90),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(177),COLBF(90),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01036')
      RETURN
      END
      SUBROUTINE S01037(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 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 C00318(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "avasec"',
     *  ' in equation "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'avasec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00318(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),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(177),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "avasec"',
     *  ' in equation "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01037')
      RETURN
      END
      SUBROUTINE S01039(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00307,C00320,C00321,
     *  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 I00007
      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 C00307(SSZ(28),SSZ(1))
      REAL C00320(SSZ(9),SSZ(1))
      REAL C00321(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 "afecom"',
     *  ' in equation "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afecom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      105)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(9)
      ENTRY=C00320(I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(13)
      ENTRY=C00321(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+I00001))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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 5 I00001=1,SSZ(28)
      ENTRY=C00307(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(177),COLBF(105),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afecom"',
     *  ' in equation "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01039')
      RETURN
      END
      SUBROUTINE S01040(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00322,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00322(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afesec"',
     *  ' in equation "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afesec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00322(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),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(177),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afesec"',
     *  ' in equation "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01040')
      RETURN
      END
      SUBROUTINE S01042(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00095,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 I00004
      INTEGER I00007
      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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00324(SSZ(9),SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afeall"',
     *  ' in equation "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afeall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(15)
      DO 3 I00007=1,SSZ(9)
      ENTRY=C00324(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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(15)
      DO 5 I00001=1,SSZ(13)
      ENTRY=-C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*(-
     *  1.0+C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+I00001))+SSZ(9)*
     *  (SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
      DO 8 I00004=1,SSZ(15)
      DO 7 I00001=1,SSZ(28)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    7 CONTINUE
    8 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(177),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afeall"',
     *  ' in equation "FFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01042')
      RETURN
      END
      SUBROUTINE S01045(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00313,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00313(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 "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(13)
      ENTRY=C00313(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(26)-1+
     *  SSMP(SSMPST(28)-1+I00001))))+SSZ(12)*(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(178),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 "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01045')
      RETURN
      END
      SUBROUTINE S01046(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 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 C00314(SSZ(15),SSZ(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 "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       13)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00314(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)))+SSZ(12)*(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
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(178),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01046')
      RETURN
      END
      SUBROUTINE S01047(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00315,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00315(SSZ(15),SSZ(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 "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       14)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00315(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)))+SSZ(12)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(178),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01047')
      RETURN
      END
      SUBROUTINE S01048(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00095,C00316,
     *  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 I00007
      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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00316(SSZ(9),SSZ(15),SSZ(1))
      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 "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       15)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(15)
      DO 3 I00001=1,SSZ(13)
      ENTRY=C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*
     *  C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+I00001))+SSZ(9)*
     *  (SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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(15)
      DO 5 I00007=1,SSZ(9)
      ENTRY=C00316(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
      DO 8 I00004=1,SSZ(15)
      DO 7 I00001=1,SSZ(28)
      ENTRY=C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
    7 CONTINUE
    8 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(178),COLBF(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfe"',
     *  ' in equation "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01048')
      RETURN
      END
      SUBROUTINE S01052(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 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 C00318(SSZ(15),SSZ(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 "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       88)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00318(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        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
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(178),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01052')
      RETURN
      END
      SUBROUTINE S01054(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 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 C00318(SSZ(15),SSZ(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 "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       90)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00318(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))+SSZ(10)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(90),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(178),COLBF(90),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01054')
      RETURN
      END
      SUBROUTINE S01055(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 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 C00318(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "avasec"',
     *  ' in equation "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'avasec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00318(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),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(178),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "avasec"',
     *  ' in equation "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01055')
      RETURN
      END
      SUBROUTINE S01057(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00307,C00320,C00321,
     *  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 I00007
      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 C00307(SSZ(28),SSZ(1))
      REAL C00320(SSZ(9),SSZ(1))
      REAL C00321(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 "afecom"',
     *  ' in equation "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afecom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      105)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 3 I00007=1,SSZ(9)
      ENTRY=C00320(I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(13)
      ENTRY=C00321(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+I00001))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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 5 I00001=1,SSZ(28)
      ENTRY=C00307(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(178),COLBF(105),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afecom"',
     *  ' in equation "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01057')
      RETURN
      END
      SUBROUTINE S01058(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00322,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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
      REAL C00322(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afesec"',
     *  ' in equation "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afesec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 2 I00004=1,SSZ(15)
      ENTRY=C00322(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),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(178),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afesec"',
     *  ' in equation "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01058')
      RETURN
      END
      SUBROUTINE S01060(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00095,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 I00004
      INTEGER I00007
      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 C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00324(SSZ(9),SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afeall"',
     *  ' in equation "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afeall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(1)
      RWN=RWN+1
      DO 4 I00004=1,SSZ(15)
      DO 3 I00007=1,SSZ(9)
      ENTRY=C00324(I00007,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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(15)
      DO 5 I00001=1,SSZ(13)
      ENTRY=-C00021(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00001)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*(-
     *  1.0+C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+I00001))+SSZ(9)*
     *  (SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
      DO 8 I00004=1,SSZ(15)
      DO 7 I00001=1,SSZ(28)
      ENTRY=-C00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004)),I00002)*(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00004)),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+I00001)+SSZ(9)*(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00004))-1+SSZ(10)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    7 CONTINUE
    8 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(178),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER('eq',IER,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW(
     *  ' while calculating submatrix for variable "afeall"',
     *  ' in equation "FFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01060')
      RETURN
      END
      SUBROUTINE S01067(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(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 "FARMINCOMEEQN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      140)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-100.0 *C00178(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(140),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(140),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "FARMINCOMEEQN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01067')
      RETURN
      END
      SUBROUTINE S01069(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00175(SSZ(1))
      REAL C00178(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yf"',
     *  ' in equation "FARMINCOMEEQN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      213)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00178(I00002)-C00175(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(213),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(213),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "yf"',
     *  ' in equation "FARMINCOMEEQN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01069')
      RETURN
      END
      SUBROUTINE S01070(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00179,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00179(SSZ(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 "FINCOMEEQNON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      140)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-100.0 *C00179(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(140),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(140),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "FINCOMEEQNON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01070')
      RETURN
      END
      SUBROUTINE S01072(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00176,C00179,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 C00176(SSZ(1))
      REAL C00179(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yfon"',
     *  ' in equation "FINCOMEEQNON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yfon',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      214)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00179(I00002)-C00176(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(214),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(214),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "yfon"',
     *  ' in equation "FINCOMEEQNON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01072')
      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''',
     *    '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(206),ECHO1,
     *  ROWBF(176),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(207),ECHO1,
     *  ROWBF(176),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(208),ECHO1,
     *  ROWBF(176),COLBF(208),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(209),ECHO1,
     *  ROWBF(176),COLBF(209),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''',
     *    'FFACTORINCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01026(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00313,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01027(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),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 S01028(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00315,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01029(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00095,C00316,
     *  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(21),ECHO1,
     *  ROWBF(177),COLBF(21),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(22),ECHO1,
     *  ROWBF(177),COLBF(22),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),SSZ(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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01032(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(24),KZC,DOEQ,STRHS,STRHNZ,
     *  C00163,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 S01033(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(25),KZC,DOEQ,STRHS,STRHNZ,
     *  C00163,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 S01034(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(88),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(89),ECHO1,
     *  ROWBF(177),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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 S01036(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(90),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01037(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(91),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(92),ECHO1,
     *  ROWBF(177),COLBF(92),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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 S01039(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(105),KZC,DOEQ,STRHS,STRHNZ,
     *  C00307,C00320,C00321,
     *  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 S01040(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00322,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(107),ECHO1,
     *  ROWBF(177),COLBF(107),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00323,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01042(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00095,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(154),ECHO1,
     *  ROWBF(177),COLBF(154),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),SSZ(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(210),ECHO1,
     *  ROWBF(177),COLBF(210),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00172,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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''',
     *    'FFINCON',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01045(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00313,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01046(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),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 S01047(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00315,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01048(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00095,C00316,
     *  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(21),ECHO1,
     *  ROWBF(178),COLBF(21),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(24),ECHO1,
     *  ROWBF(178),COLBF(24),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(25),ECHO1,
     *  ROWBF(178),COLBF(25),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 S01052(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(88),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(89),ECHO1,
     *  ROWBF(178),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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 S01054(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(90),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01055(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(91),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(92),ECHO1,
     *  ROWBF(178),COLBF(92),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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 S01057(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(105),KZC,DOEQ,STRHS,STRHNZ,
     *  C00307,C00320,C00321,
     *  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 S01058(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00322,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(107),ECHO1,
     *  ROWBF(178),COLBF(107),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00323,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01060(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00021,C00095,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(211),ECHO1,
     *  ROWBF(178),COLBF(211),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'FFINCOFF',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(179),COLBF(22),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),SSZ(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(24),ECHO1,
     *  ROWBF(179),COLBF(24),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00171,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(25),ECHO1,
     *  ROWBF(179),COLBF(25),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00171,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(179),COLBF(154),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(28),SSZ(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(212),ECHO1,
     *  ROWBF(179),COLBF(212),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'FARMINCOMEEQN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01067(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(140),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(210),ECHO1,
     *  ROWBF(180),COLBF(210),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00172,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01069(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(213),KZC,DOEQ,STRHS,STRHNZ,
     *  C00175,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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'FINCOMEEQNON',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01070(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(140),KZC,DOEQ,STRHS,STRHNZ,
     *  C00179,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(211),ECHO1,
     *  ROWBF(181),COLBF(211),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01072(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(214),KZC,DOEQ,STRHS,STRHNZ,
     *  C00176,C00179,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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('M00026')
      RETURN
      END
      SUBROUTINE S01073(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 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 C00180(SSZ(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 "FINCOMEEQNOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      140)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=-100.0 *C00180(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(140),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(182),COLBF(140),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "FINCOMEEQNOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01073')
      RETURN
      END
      SUBROUTINE S01075(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00177,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 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 C00177(SSZ(1))
      REAL C00180(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yfoff"',
     *  ' in equation "FINCOMEEQNOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yfoff',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      215)
      DO     1 I00002=1,SSZ(1)
      RWN=RWN+1
      ENTRY=C00180(I00002)-C00177(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(215),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(182),COLBF(215),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "yfoff"',
     *  ' in equation "FINCOMEEQNOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01075')
      RETURN
      END
      SUBROUTINE S01076(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "ps"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       13)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)))+SSZ(12)*(SSMP(SSMPST(1)-1+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
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),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
    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 "usFFACTORINCOME"',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,
     *  C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "qo"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       14)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)))+SSZ(12)*(SSMP(SSMPST(1)-1+I00002)-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(183),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "usFFACTORINCOME"',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,
     *  C00086,C00094,C00095,C00199,
     *  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 I00007
      INTEGER I00012
      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 C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "pfe"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       15)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(2)
      DO     3 I00004=1,SSZ(3)
      DO     4 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 5 I00012=1,SSZ(15)
      ENTRY=C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*
     *  C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+SSMP(SSMPST(37)-1+
     *  1)))+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))-1+
     *  SSZ(10)*(SSMP(SSMPST(1)-1+I00002)-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
    5 CONTINUE
      DO 7 I00012=1,SSZ(15)
      DO 6 I00007=1,SSZ(9)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002)))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012))-1+SSZ(10)*(SSMP(SSMPST(1)-1+I00002)-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
    6 CONTINUE
    7 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfe"',
     *  ' in equation "usFFACTORINCOME"',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,
     *  C00192,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00192(SSZ(9),SSZ(4),SSZ(3),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 "pmagr"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00011=1,SSZ(28)
      ENTRY=-C00192(SSMP(SSMPST(27)-1+I00011),I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(28)*(SSMP(SSMPST(1)-1+I00002)-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),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(183),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pmagr"',
     *  ' in equation "usFFACTORINCOME"',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,
     *  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 I00004
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(28),SSZ(4),SSZ(3),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 "pmnagr"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmnagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00011=1,SSZ(28)
      ENTRY=-C00209(I00011,I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(28)*(SSMP(SSMPST(1)-1+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
    4 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
    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 "pmnagr"',
     *  ' in equation "usFFACTORINCOME"',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,
     *  C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "pmes"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       23)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(28)-1+SSMP(SSMPST(37)-1+1))+SSZ(27)*
     *  (SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))-1+SSZ(10)*
     *  (SSMP(SSMPST(1)-1+I00002)-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),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(183),COLBF(23),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "usFFACTORINCOME"',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,
     *  C00211,C00213,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00211(SSZ(4),SSZ(3),SSZ(2))
      REAL C00213(SSZ(4),SSZ(3),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 "kb"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       24)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00211(I00001,I00004,I00002)+C00213(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(24),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(24),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "kb"',
     *  ' in equation "usFFACTORINCOME"',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,
     *  C00211,C00213,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00211(SSZ(4),SSZ(3),SSZ(2))
      REAL C00213(SSZ(4),SSZ(3),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 "pcgds"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       25)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00211(I00001,I00004,I00002)+C00213(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(25),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(25),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pcgds"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01083')
      RETURN
      END
      SUBROUTINE S01084(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "aosec"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       88)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))
        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
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),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 "aosec"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01084')
      RETURN
      END
      SUBROUTINE S01085(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 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 C00325(SSZ(4),SSZ(3),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 "aoreg"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       89)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00325(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        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(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
    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 "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01085')
      RETURN
      END
      SUBROUTINE S01086(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "aoall"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       90)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))+SSZ(10)*
     *  (SSMP(SSMPST(1)-1+I00002)-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(90),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(183),COLBF(90),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01086')
      RETURN
      END
      SUBROUTINE S01087(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "avasec"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'avasec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),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(183),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "avasec"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01087')
      RETURN
      END
      SUBROUTINE S01088(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 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 C00325(SSZ(4),SSZ(3),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 "avareg"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'avareg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       92)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00325(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),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(92),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "avareg"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01088')
      RETURN
      END
      SUBROUTINE S01089(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,C00199,C00326,
     *  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 I00007
      INTEGER I00012
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL C00326(SSZ(4),SSZ(3),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 "afecom"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afecom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      105)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(2)
      DO     3 I00004=1,SSZ(3)
      DO     4 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 5 I00007=1,SSZ(9)
      RS1=0.0
      DO 6 I00012=1,SSZ(15)
      RS1=RS1-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*
     *  (-C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002)))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))
    6 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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
    5 CONTINUE
      ENTRY=C00326(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+SSMP(SSMPST(37)-1+
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(105),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afecom"',
     *  ' in equation "usFFACTORINCOME"',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,
     *  C00086,C00095,C00199,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL C00278(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afesec"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afesec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*((-
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002)))*
     *  C00278(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))-(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002))))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),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(183),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afesec"',
     *  ' in equation "usFFACTORINCOME"',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,
     *  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 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 C00327(SSZ(4),SSZ(3),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 "afereg"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afereg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      107)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00327(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),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(107),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afereg"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01091')
      RETURN
      END
      SUBROUTINE S01092(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,C00199,
     *  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 I00007
      INTEGER I00012
      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 C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "afeall"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afeall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(2)
      DO     3 I00004=1,SSZ(3)
      DO     4 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 6 I00012=1,SSZ(15)
      DO 5 I00007=1,SSZ(9)
      ENTRY=C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002)))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012))-1+SSZ(10)*(SSMP(SSMPST(1)-1+I00002)-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    5 CONTINUE
    6 CONTINUE
      DO 7 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  1.0+C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+SSMP(SSMPST(37)-1+
     *  1)))+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))-1+
     *  SSZ(10)*(SSMP(SSMPST(1)-1+I00002)-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    7 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
    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 "afeall"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01092')
      RETURN
      END
      SUBROUTINE S01093(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00192(SSZ(9),SSZ(4),SSZ(3),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 "qoagr"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qoagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      152)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00011=1,SSZ(28)
      ENTRY=-C00192(SSMP(SSMPST(27)-1+I00011),I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(28)*(SSMP(SSMPST(1)-1+I00002)-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(152),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(183),COLBF(152),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "qoagr"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01093')
      RETURN
      END
      SUBROUTINE S01094(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 I00004
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(28),SSZ(4),SSZ(3),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 "qonagr"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qonagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      154)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00011=1,SSZ(28)
      ENTRY=-C00209(I00011,I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(28)*(SSMP(SSMPST(1)-1+I00002)-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(154),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(183),COLBF(154),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "qonagr"',
     *  ' in equation "usFFACTORINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01094')
      RETURN
      END
      SUBROUTINE S01096(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "ps"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       13)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)))+SSZ(12)*(SSMP(SSMPST(1)-1+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
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(184),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
    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 "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01096')
      RETURN
      END
      SUBROUTINE S01097(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "qo"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       14)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)))+SSZ(12)*(SSMP(SSMPST(1)-1+I00002)-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(14),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(184),COLBF(14),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01097')
      RETURN
      END
      SUBROUTINE S01098(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,C00199,
     *  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 I00007
      INTEGER I00012
      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 C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "pfe"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       15)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(2)
      DO     3 I00004=1,SSZ(3)
      DO     4 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 5 I00012=1,SSZ(15)
      ENTRY=C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*
     *  C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+SSMP(SSMPST(37)-1+
     *  1)))+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))-1+
     *  SSZ(10)*(SSMP(SSMPST(1)-1+I00002)-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
    5 CONTINUE
      DO 7 I00012=1,SSZ(15)
      DO 6 I00007=1,SSZ(9)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002)))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012))-1+SSZ(10)*(SSMP(SSMPST(1)-1+I00002)-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(15),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
    6 CONTINUE
    7 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(184),COLBF(15),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfe"',
     *  ' in equation "usFFINCON"',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,
     *  C00192,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00192(SSZ(9),SSZ(4),SSZ(3),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 "pmagr"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00011=1,SSZ(28)
      ENTRY=-C00192(SSMP(SSMPST(27)-1+I00011),I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(28)*(SSMP(SSMPST(1)-1+I00002)-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),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(184),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pmagr"',
     *  ' in equation "usFFINCON"',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,
     *  C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "pmes"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       23)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(28)-1+SSMP(SSMPST(37)-1+1))+SSZ(27)*
     *  (SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))-1+SSZ(10)*
     *  (SSMP(SSMPST(1)-1+I00002)-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),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(184),COLBF(23),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "usFFINCON"',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,
     *  C00211,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00211(SSZ(4),SSZ(3),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 "kb"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       24)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00211(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(24),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(184),COLBF(24),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "kb"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01101')
      RETURN
      END
      SUBROUTINE S01102(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00211,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00211(SSZ(4),SSZ(3),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 "pcgds"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       25)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00211(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(25),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(184),COLBF(25),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pcgds"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01102')
      RETURN
      END
      SUBROUTINE S01103(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "aosec"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       88)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))
        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
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(184),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 "aosec"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01103')
      RETURN
      END
      SUBROUTINE S01104(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 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 C00325(SSZ(4),SSZ(3),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 "aoreg"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       89)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00325(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        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(184),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 "aoreg"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01104')
      RETURN
      END
      SUBROUTINE S01105(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "aoall"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       90)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))+SSZ(10)*
     *  (SSMP(SSMPST(1)-1+I00002)-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(90),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(184),COLBF(90),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "usFFINCON"',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,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "avasec"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'avasec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       91)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  1.0+C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(91),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(184),COLBF(91),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "avasec"',
     *  ' in equation "usFFINCON"',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,
     *  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 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 C00325(SSZ(4),SSZ(3),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 "avareg"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'avareg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       92)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00325(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),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(184),COLBF(92),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "avareg"',
     *  ' in equation "usFFINCON"',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,
     *  C00086,C00094,C00095,C00199,C00326,
     *  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 I00007
      INTEGER I00012
      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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL C00326(SSZ(4),SSZ(3),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 "afecom"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afecom',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      105)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(2)
      DO     3 I00004=1,SSZ(3)
      DO     4 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 5 I00007=1,SSZ(9)
      RS1=0.0
      DO 6 I00012=1,SSZ(15)
      RS1=RS1-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*
     *  (-C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002)))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))
    6 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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
    5 CONTINUE
      ENTRY=C00326(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+SSMP(SSMPST(37)-1+
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(105),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(184),COLBF(105),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afecom"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01108')
      RETURN
      END
      SUBROUTINE S01109(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00095,C00199,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00012
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL C00278(SSZ(10),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afesec"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afesec',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      106)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00012=1,SSZ(15)
      ENTRY=C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*((-
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002)))*
     *  C00278(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))-(-1.0+C00095(SSMP(SSMPST(4)-
     *  1+SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002))))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),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(184),COLBF(106),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afesec"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01109')
      RETURN
      END
      SUBROUTINE S01110(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 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 C00327(SSZ(4),SSZ(3),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 "afereg"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afereg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      107)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00327(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),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(184),COLBF(107),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "afereg"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01110')
      RETURN
      END
      SUBROUTINE S01111(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,C00199,
     *  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 I00007
      INTEGER I00012
      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 C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),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 "afeall"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'afeall',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      108)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO     2 I00002=1,SSZ(2)
      DO     3 I00004=1,SSZ(3)
      DO     4 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 6 I00012=1,SSZ(15)
      DO 5 I00007=1,SSZ(9)
      ENTRY=C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  C00086(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))+C00095(SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002)))*
     *  C00094(I00007,SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012))-1+SSZ(10)*(SSMP(SSMPST(1)-1+I00002)-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    5 CONTINUE
    6 CONTINUE
      DO 7 I00012=1,SSZ(15)
      ENTRY=-C00199(SSMP(SSMPST(37)-1+1),I00001,I00004,I00012,I00002)*(-
     *  1.0+C00095(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+SSMP(SSMPST(37)-1+
     *  1)))+SSZ(9)*(SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00012))-1+
     *  SSZ(10)*(SSMP(SSMPST(1)-1+I00002)-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(108),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
    7 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(184),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
    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 "afeall"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01111')
      RETURN
      END
      SUBROUTINE S01112(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00192(SSZ(9),SSZ(4),SSZ(3),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 "qoagr"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qoagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      152)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00011=1,SSZ(28)
      ENTRY=-C00192(SSMP(SSMPST(27)-1+I00011),I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(28)*(SSMP(SSMPST(1)-1+I00002)-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(152),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(184),COLBF(152),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "qoagr"',
     *  ' in equation "usFFINCON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01112')
      RETURN
      END
      SUBROUTINE S01114(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 I00004
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(28),SSZ(4),SSZ(3),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 "pmnagr"',
     *  ' in equation "usFFINCOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmnagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00011=1,SSZ(28)
      ENTRY=-C00209(I00011,I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(28)*(SSMP(SSMPST(1)-1+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
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),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
    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 "pmnagr"',
     *  ' in equation "usFFINCOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01114')
      RETURN
      END
      SUBROUTINE S01115(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00213,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00213(SSZ(4),SSZ(3),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 "kb"',
     *  ' in equation "usFFINCOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       24)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00213(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(24),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(24),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "kb"',
     *  ' in equation "usFFINCOFF"',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,
     *  C00213,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00213(SSZ(4),SSZ(3),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 "pcgds"',
     *  ' in equation "usFFINCOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       25)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00213(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(25),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(25),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pcgds"',
     *  ' in equation "usFFINCOFF"',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,
     *  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 I00004
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(28),SSZ(4),SSZ(3),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 "qonagr"',
     *  ' in equation "usFFINCOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qonagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      154)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00011=1,SSZ(28)
      ENTRY=-C00209(I00011,I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00011+SSZ(28)*(SSMP(SSMPST(1)-1+I00002)-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(154),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(185),COLBF(154),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "qonagr"',
     *  ' in equation "usFFINCOFF"',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,
     *  C00220,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00220(SSZ(4),SSZ(3),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 "del_indtaxr"',
     *  ' in equation "usFARMINCOMEEQN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      140)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-100.0 *C00220(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(140),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(140),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "del_indtaxr"',
     *  ' in equation "usFARMINCOMEEQN"',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,
     *  C00217,C00220,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00217(SSZ(4),SSZ(3),SSZ(2))
      REAL C00220(SSZ(4),SSZ(3),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 "usyf"',
     *  ' in equation "usFARMINCOMEEQN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'usyf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      219)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00220(I00001,I00004,I00002)-C00217(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(219),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(219),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "usyf"',
     *  ' in equation "usFARMINCOMEEQN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01121')
      RETURN
      END
      SUBROUTINE S01122(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00221,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00221(SSZ(4),SSZ(3),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 "del_indtaxr"',
     *  ' in equation "usFINCOMEEQNON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      140)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-100.0 *C00221(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(140),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(140),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "del_indtaxr"',
     *  ' in equation "usFINCOMEEQNON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01122')
      RETURN
      END
      SUBROUTINE S01124(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00218,C00221,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00218(SSZ(4),SSZ(3),SSZ(2))
      REAL C00221(SSZ(4),SSZ(3),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 "usyfon"',
     *  ' in equation "usFINCOMEEQNON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'usyfon',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      220)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00221(I00001,I00004,I00002)-C00218(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(220),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(220),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "usyfon"',
     *  ' in equation "usFINCOMEEQNON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01124')
      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''',
     *    'FINCOMEEQNOFF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01073(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(140),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(212),ECHO1,
     *  ROWBF(182),COLBF(212),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01075(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(215),KZC,DOEQ,STRHS,STRHNZ,
     *  C00177,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''',
     *    'usFFACTORINCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01076(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(15),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,C00199,
     *  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(21),KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(22),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01081(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(24),KZC,DOEQ,STRHS,STRHNZ,
     *  C00211,C00213,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(25),KZC,DOEQ,STRHS,STRHNZ,
     *  C00211,C00213,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01084(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01085(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(89),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 S01086(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01087(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(91),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01088(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(92),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 S01089(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(105),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,C00199,C00326,
     *  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 S01090(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00095,C00199,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(107),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 S01092(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,C00199,
     *  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 S01093(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(152),KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01094(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(154),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(216),ECHO1,
     *  ROWBF(183),COLBF(216),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(2),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'usFFINCON',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01096(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01097(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(14),KZC,DOEQ,STRHS,STRHNZ,
     *  C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01098(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(15),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,C00199,
     *  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 S01099(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(21),KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(24),KZC,DOEQ,STRHS,STRHNZ,
     *  C00211,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01102(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(25),KZC,DOEQ,STRHS,STRHNZ,
     *  C00211,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01103(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01104(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(89),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 S01105(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(91),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00199,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(92),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 S01108(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(105),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,C00199,C00326,
     *  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 S01109(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00095,C00199,C00278,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01110(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(107),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 S01111(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(108),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00094,C00095,C00199,
     *  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 S01112(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(152),KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(217),ECHO1,
     *  ROWBF(184),COLBF(217),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(2),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'usFFINCOFF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01114(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01115(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(24),KZC,DOEQ,STRHS,STRHNZ,
     *  C00213,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(25),KZC,DOEQ,STRHS,STRHNZ,
     *  C00213,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(154),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(218),ECHO1,
     *  ROWBF(185),COLBF(218),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(2),1,1,1,1,C00216,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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''',
     *    'usFARMINCOMEEQN',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(140),KZC,DOEQ,STRHS,STRHNZ,
     *  C00220,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(216),ECHO1,
     *  ROWBF(186),COLBF(216),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(2),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01121(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(219),KZC,DOEQ,STRHS,STRHNZ,
     *  C00217,C00220,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'usFINCOMEEQNON',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01122(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(140),KZC,DOEQ,STRHS,STRHNZ,
     *  C00221,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(217),ECHO1,
     *  ROWBF(187),COLBF(217),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(2),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01124(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(220),KZC,DOEQ,STRHS,STRHNZ,
     *  C00218,C00221,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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('M00027')
      RETURN
      END
      SUBROUTINE S01125(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00222,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00222(SSZ(4),SSZ(3),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 "del_indtaxr"',
     *  ' in equation "usFINCOMEEQNOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(      140)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=-100.0 *C00222(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(140),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(188),COLBF(140),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "del_indtaxr"',
     *  ' in equation "usFINCOMEEQNOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01125')
      RETURN
      END
      SUBROUTINE S01127(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00219,C00222,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,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 C00219(SSZ(4),SSZ(3),SSZ(2))
      REAL C00222(SSZ(4),SSZ(3),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 "usyfoff"',
     *  ' in equation "usFINCOMEEQNOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'usyfoff',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      221)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00004=1,SSZ(3)
      DO     3 I00001=1,SSZ(4)
      RWN=RWN+1
      ENTRY=C00222(I00001,I00004,I00002)-C00219(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(4)*(I00004-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(221),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(188),COLBF(221),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "usyfoff"',
     *  ' in equation "usFINCOMEEQNOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01127')
      RETURN
      END
      SUBROUTINE S01137(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,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 I00007
      INTEGER I00014
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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,RS5,RS6
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00223(SSZ(4),SSZ(3),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 "p_aUCONSUSA"',
     *  ' in equation "E_aPHIUSA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aUCONSUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      228)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00007=1,SSZ(3)
      DO     3 I00014=1,SSZ(4)
      DO     4 I00001=1,SSZ(30)
      RWN=RWN+1
      RS1=1.0
      RS2=C00067(I00001,SSMP(SSMPST(1)-1+I00002))+
     *  C00068(I00001,SSMP(SSMPST(1)-1+I00002))*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=1.0
      RS5=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IER=2
      END IF
      ENTRY=-(RS3*C00068(I00001,SSMP(SSMPST(1)-1+I00002))*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))*
     *  C00223(I00014,I00007,I00002)-RS6*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))*
     *  C00223(I00014,I00007,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00014+SSZ(4)*(I00007-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(228),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(195),COLBF(228),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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_aUCONSUSA"',
     *  ' in equation "E_aPHIUSA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01137')
      RETURN
      END
      SUBROUTINE S01139(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,C00069,C00223,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 I00007
      INTEGER I00014
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15,RS16,RS17,RS18,RS19,RS20,RS21,RS22,RS23,RS24,RS25,RS26
      REAL RS27,RS28,RS29
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00223(SSZ(4),SSZ(3),SSZ(2))
      REAL C00224(SSZ(30),SSZ(4),SSZ(3),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 "p_aUCONSUSA"',
     *  ' in equation "E_aEPSINUSA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aUCONSUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      228)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00007=1,SSZ(3)
      DO     3 I00014=1,SSZ(4)
      RWN=RWN+1
      RS1=0.0
      DO 4 I00001=1,SSZ(30)
      RS2=REAL(C00224(I00001,I00014,I00007,I00002)-
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002)))
      IF(RS2.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      RS1=RS1+(C00068(I00001,SSMP(SSMPST(1)-1+I00002))-
     *  C00067(I00001,SSMP(SSMPST(1)-1+I00002)))*LOG(RS2)
    4 CONTINUE
      RS3=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      RS4=2
      IF(RS3.GT.0.0) THEN
        RS5=RS3**RS4
      ELSE IF(RS3.EQ.0.0 .AND. RS4.GT.0.0) THEN
        RS5=0.0
      ELSE IF(RS3.EQ.0.0 .AND. RS4.EQ.0.0) THEN
        RS5=1.0
        IER=11
      ELSE IF(RS3.EQ.0.0 .AND. RS4.LT.0.0) THEN
        RS5=1.0
        IER=12
      ELSE
        IF(RS4.EQ.0.0) THEN
          RS5=1.0
          IER=13
        ELSE IF(INT(RS4).EQ.RS4) THEN
          RS5=RS3**INT(RS4)
        ELSE
          RS5=1.0
          IER=14
        END IF
      END IF
      RS6=RS5
      RS7=EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS9=RS1-(RS8)
      RS10=2
      IF(RS9.GT.0.0) THEN
        RS11=RS9**RS10
      ELSE IF(RS9.EQ.0.0 .AND. RS10.GT.0.0) THEN
        RS11=0.0
      ELSE IF(RS9.EQ.0.0 .AND. RS10.EQ.0.0) THEN
        RS11=1.0
        IER=11
      ELSE IF(RS9.EQ.0.0 .AND. RS10.LT.0.0) THEN
        RS11=1.0
        IER=12
      ELSE
        IF(RS10.EQ.0.0) THEN
          RS11=1.0
          IER=13
        ELSE IF(INT(RS10).EQ.RS10) THEN
          RS11=RS9**INT(RS10)
        ELSE
          RS11=1.0
          IER=14
        END IF
      END IF
      RS12=-1.0
      RS13=RS11
      IF(RS13.NE.0.0) THEN
        RS14=RS12/RS13
      ELSE
        RS14=1.0
        IER=2
      END IF
      RS15=1.0
      RS16=EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS16.NE.0.0) THEN
        RS17=RS15/RS16
      ELSE
        RS17=1.0
        IER=2
      END IF
      RS18=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      RS19=2  -1
      IF(RS18.GT.0.0) THEN
        RS20=RS18**RS19
      ELSE IF(RS18.EQ.0.0 .AND. RS19.GT.0.0) THEN
        RS20=0.0
      ELSE IF(RS18.EQ.0.0 .AND. RS19.EQ.0.0) THEN
        RS20=1.0
        IER=11
      ELSE IF(RS18.EQ.0.0 .AND. RS19.LT.0.0) THEN
        RS20=1.0
        IER=12
      ELSE
        IF(RS19.EQ.0.0) THEN
          RS20=1.0
          IER=13
        ELSE IF(INT(RS19).EQ.RS19) THEN
          RS20=RS18**INT(RS19)
        ELSE
          RS20=1.0
          IER=14
        END IF
      END IF
      RS21=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      RS22=2
      IF(RS21.GT.0.0) THEN
        RS23=RS21**RS22
      ELSE IF(RS21.EQ.0.0 .AND. RS22.GT.0.0) THEN
        RS23=0.0
      ELSE IF(RS21.EQ.0.0 .AND. RS22.EQ.0.0) THEN
        RS23=1.0
        IER=11
      ELSE IF(RS21.EQ.0.0 .AND. RS22.LT.0.0) THEN
        RS23=1.0
        IER=12
      ELSE
        IF(RS22.EQ.0.0) THEN
          RS23=1.0
          IER=13
        ELSE IF(INT(RS22).EQ.RS22) THEN
          RS23=RS21**INT(RS22)
        ELSE
          RS23=1.0
          IER=14
        END IF
      END IF
      RS24=EXP(REAL(C00223(I00014,I00007,I00002)))
      RS25=2
      IF(RS24.GT.0.0) THEN
        RS26=RS24**RS25
      ELSE IF(RS24.EQ.0.0 .AND. RS25.GT.0.0) THEN
        RS26=0.0
      ELSE IF(RS24.EQ.0.0 .AND. RS25.EQ.0.0) THEN
        RS26=1.0
        IER=11
      ELSE IF(RS24.EQ.0.0 .AND. RS25.LT.0.0) THEN
        RS26=1.0
        IER=12
      ELSE
        IF(RS25.EQ.0.0) THEN
          RS26=1.0
          IER=13
        ELSE IF(INT(RS25).EQ.RS25) THEN
          RS26=RS24**INT(RS25)
        ELSE
          RS26=1.0
          IER=14
        END IF
      END IF
      RS27=RS23
      RS28=RS26
      IF(RS28.NE.0.0) THEN
        RS29=RS27/RS28
      ELSE
        RS29=1.0
        IER=2
      END IF
      ENTRY=RS14*(RS17*2  *(RS20)*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))*
     *  C00223(I00014,I00007,I00002)-(RS29)*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))*
     *  C00223(I00014,I00007,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00014+SSZ(4)*(I00007-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(228),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(196),COLBF(228),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "p_aUCONSUSA"',
     *  ' in equation "E_aEPSINUSA"',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,
     *  C00067,C00068,C00069,C00223,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 I00007
      INTEGER I00014
      INTEGER I00017
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15,RS16,RS17
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00223(SSZ(4),SSZ(3),SSZ(2))
      REAL C00224(SSZ(30),SSZ(4),SSZ(3),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 "p_aQUSA"',
     *  ' in equation "E_aEPSINUSA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aQUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      229)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00007=1,SSZ(3)
      DO     3 I00014=1,SSZ(4)
      RWN=RWN+1
      RS1=0.0
      DO 4 I00017=1,SSZ(30)
      RS2=REAL(C00224(I00017,I00014,I00007,I00002)-
     *  C00069(I00017,SSMP(SSMPST(1)-1+I00002)))
      IF(RS2.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      RS1=RS1+(C00068(I00017,SSMP(SSMPST(1)-1+I00002))-
     *  C00067(I00017,SSMP(SSMPST(1)-1+I00002)))*LOG(RS2)
    4 CONTINUE
      DO 5 I00001=1,SSZ(30)
      RS3=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      RS4=2
      IF(RS3.GT.0.0) THEN
        RS5=RS3**RS4
      ELSE IF(RS3.EQ.0.0 .AND. RS4.GT.0.0) THEN
        RS5=0.0
      ELSE IF(RS3.EQ.0.0 .AND. RS4.EQ.0.0) THEN
        RS5=1.0
        IER=11
      ELSE IF(RS3.EQ.0.0 .AND. RS4.LT.0.0) THEN
        RS5=1.0
        IER=12
      ELSE
        IF(RS4.EQ.0.0) THEN
          RS5=1.0
          IER=13
        ELSE IF(INT(RS4).EQ.RS4) THEN
          RS5=RS3**INT(RS4)
        ELSE
          RS5=1.0
          IER=14
        END IF
      END IF
      RS6=RS5
      RS7=EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS9=RS1-(RS8)
      RS10=2
      IF(RS9.GT.0.0) THEN
        RS11=RS9**RS10
      ELSE IF(RS9.EQ.0.0 .AND. RS10.GT.0.0) THEN
        RS11=0.0
      ELSE IF(RS9.EQ.0.0 .AND. RS10.EQ.0.0) THEN
        RS11=1.0
        IER=11
      ELSE IF(RS9.EQ.0.0 .AND. RS10.LT.0.0) THEN
        RS11=1.0
        IER=12
      ELSE
        IF(RS10.EQ.0.0) THEN
          RS11=1.0
          IER=13
        ELSE IF(INT(RS10).EQ.RS10) THEN
          RS11=RS9**INT(RS10)
        ELSE
          RS11=1.0
          IER=14
        END IF
      END IF
      RS12=1.0
      RS13=RS11
      IF(RS13.NE.0.0) THEN
        RS14=RS12/RS13
      ELSE
        RS14=1.0
        IER=2
      END IF
      RS15=RS14*(C00068(I00001,SSMP(SSMPST(1)-1+I00002))-
     *  C00067(I00001,SSMP(SSMPST(1)-1+I00002)))
      RS16=C00224(I00001,I00014,I00007,I00002)-
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002))
      IF(RS16.NE.0.0) THEN
        RS17=RS15/RS16
      ELSE
        RS17=1.0
        IER=2
      END IF
      ENTRY=RS17*C00224(I00001,I00014,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(30)*(I00014-1+SSZ(4)*(I00007-1+SSZ(3)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(229),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF
      END IF
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(196),COLBF(229),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "p_aQUSA"',
     *  ' in equation "E_aEPSINUSA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01140')
      RETURN
      END
      SUBROUTINE S01143(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00224,C00225,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00069(SSZ(30),SSZ(1))
      REAL C00224(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00225(SSZ(30),SSZ(4),SSZ(3),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 "p_aQUSA"',
     *  ' in equation "aPRIVATEUSA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aQUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      229)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00007=1,SSZ(3)
      DO     3 I00014=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00001=1,SSZ(30)
      RS1=C00225(I00001,I00014,I00007,I00002)
      RS2=C00224(I00001,I00014,I00007,I00002)-
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00224(I00001,I00014,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(30)*(I00014-1+SSZ(4)*(I00007-1+SSZ(3)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(229),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(197),COLBF(229),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "p_aQUSA"',
     *  ' in equation "aPRIVATEUSA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01143')
      RETURN
      END
      SUBROUTINE S01144(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00224,C00225,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00069(SSZ(30),SSZ(1))
      REAL C00224(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00225(SSZ(30),SSZ(4),SSZ(3),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 "p_aPHIUSA"',
     *  ' in equation "aPRIVATEUSA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aPHIUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      230)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00007=1,SSZ(3)
      DO     3 I00014=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00001=1,SSZ(30)
      RS1=REAL(C00224(I00001,I00014,I00007,I00002)-
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002)))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=LOG(RS1)*C00225(I00001,I00014,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(30)*(I00014-1+SSZ(4)*(I00007-1+SSZ(3)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(230),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(197),COLBF(230),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "p_aPHIUSA"',
     *  ' in equation "aPRIVATEUSA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01144')
      RETURN
      END
      SUBROUTINE S01145(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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 I00004
      INTEGER I00007
      INTEGER I00014
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00232(SSZ(30),SSZ(30),SSZ(4),SSZ(3),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 "p_aPP"',
     *  ' in equation "PRIVDMNDSUSA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aPP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       59)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00007=1,SSZ(3)
      DO     3 I00014=1,SSZ(4)
      DO     4 I00001=1,SSZ(30)
      RWN=RWN+1
      DO 5 I00004=1,SSZ(30)
      ENTRY=-C00232(I00001,I00004,I00014,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(30)*(SSMP(SSMPST(1)-1+I00002)-1)
        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
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(198),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
    4 CONTINUE
    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 "p_aPP"',
     *  ' in equation "PRIVDMNDSUSA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01145')
      RETURN
      END
      SUBROUTINE S01148(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,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 I00007
      INTEGER I00014
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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,RS5,RS6
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00223(SSZ(4),SSZ(3),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 "p_aUCONSUSA"',
     *  ' in equation "E_aPHIUSAEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aUCONSUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      228)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00007=1,SSZ(3)
      DO     3 I00014=1,SSZ(4)
      DO     4 I00001=1,SSZ(30)
      RWN=RWN+1
      RS1=1.0
      RS2=C00067(I00001,SSMP(SSMPST(1)-1+I00002))+
     *  C00068(I00001,SSMP(SSMPST(1)-1+I00002))*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      RS4=1.0
      RS5=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IER=2
      END IF
      ENTRY=-(RS3*C00068(I00001,SSMP(SSMPST(1)-1+I00002))*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))*
     *  C00223(I00014,I00007,I00002)-RS6*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))*
     *  C00223(I00014,I00007,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00014+SSZ(4)*(I00007-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(228),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(199),COLBF(228),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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_aUCONSUSA"',
     *  ' in equation "E_aPHIUSAEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01148')
      RETURN
      END
      SUBROUTINE S01150(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,C00069,C00223,C00234,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15,RS16,RS17,RS18,RS19,RS20,RS21,RS22,RS23,RS24,RS25,RS26
      REAL RS27,RS28,RS29
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00223(SSZ(4),SSZ(3),SSZ(2))
      REAL C00234(SSZ(30),SSZ(4),SSZ(3),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 "p_aUCONSUSA"',
     *  ' in equation "E_aEPSINUSAEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aUCONSUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      228)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00007=1,SSZ(3)
      DO     3 I00014=1,SSZ(4)
      RWN=RWN+1
      RS1=0.0
      DO 4 I00001=1,SSZ(30)
      RS2=REAL(C00234(I00001,I00014,I00007,I00002)-
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002)))
      IF(RS2.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      RS1=RS1+(C00068(I00001,SSMP(SSMPST(1)-1+I00002))-
     *  C00067(I00001,SSMP(SSMPST(1)-1+I00002)))*LOG(RS2)
    4 CONTINUE
      RS3=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      RS4=2
      IF(RS3.GT.0.0) THEN
        RS5=RS3**RS4
      ELSE IF(RS3.EQ.0.0 .AND. RS4.GT.0.0) THEN
        RS5=0.0
      ELSE IF(RS3.EQ.0.0 .AND. RS4.EQ.0.0) THEN
        RS5=1.0
        IER=11
      ELSE IF(RS3.EQ.0.0 .AND. RS4.LT.0.0) THEN
        RS5=1.0
        IER=12
      ELSE
        IF(RS4.EQ.0.0) THEN
          RS5=1.0
          IER=13
        ELSE IF(INT(RS4).EQ.RS4) THEN
          RS5=RS3**INT(RS4)
        ELSE
          RS5=1.0
          IER=14
        END IF
      END IF
      RS6=RS5
      RS7=EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS9=RS1-(RS8)
      RS10=2
      IF(RS9.GT.0.0) THEN
        RS11=RS9**RS10
      ELSE IF(RS9.EQ.0.0 .AND. RS10.GT.0.0) THEN
        RS11=0.0
      ELSE IF(RS9.EQ.0.0 .AND. RS10.EQ.0.0) THEN
        RS11=1.0
        IER=11
      ELSE IF(RS9.EQ.0.0 .AND. RS10.LT.0.0) THEN
        RS11=1.0
        IER=12
      ELSE
        IF(RS10.EQ.0.0) THEN
          RS11=1.0
          IER=13
        ELSE IF(INT(RS10).EQ.RS10) THEN
          RS11=RS9**INT(RS10)
        ELSE
          RS11=1.0
          IER=14
        END IF
      END IF
      RS12=-1.0
      RS13=RS11
      IF(RS13.NE.0.0) THEN
        RS14=RS12/RS13
      ELSE
        RS14=1.0
        IER=2
      END IF
      RS15=1.0
      RS16=EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS16.NE.0.0) THEN
        RS17=RS15/RS16
      ELSE
        RS17=1.0
        IER=2
      END IF
      RS18=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      RS19=2  -1
      IF(RS18.GT.0.0) THEN
        RS20=RS18**RS19
      ELSE IF(RS18.EQ.0.0 .AND. RS19.GT.0.0) THEN
        RS20=0.0
      ELSE IF(RS18.EQ.0.0 .AND. RS19.EQ.0.0) THEN
        RS20=1.0
        IER=11
      ELSE IF(RS18.EQ.0.0 .AND. RS19.LT.0.0) THEN
        RS20=1.0
        IER=12
      ELSE
        IF(RS19.EQ.0.0) THEN
          RS20=1.0
          IER=13
        ELSE IF(INT(RS19).EQ.RS19) THEN
          RS20=RS18**INT(RS19)
        ELSE
          RS20=1.0
          IER=14
        END IF
      END IF
      RS21=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      RS22=2
      IF(RS21.GT.0.0) THEN
        RS23=RS21**RS22
      ELSE IF(RS21.EQ.0.0 .AND. RS22.GT.0.0) THEN
        RS23=0.0
      ELSE IF(RS21.EQ.0.0 .AND. RS22.EQ.0.0) THEN
        RS23=1.0
        IER=11
      ELSE IF(RS21.EQ.0.0 .AND. RS22.LT.0.0) THEN
        RS23=1.0
        IER=12
      ELSE
        IF(RS22.EQ.0.0) THEN
          RS23=1.0
          IER=13
        ELSE IF(INT(RS22).EQ.RS22) THEN
          RS23=RS21**INT(RS22)
        ELSE
          RS23=1.0
          IER=14
        END IF
      END IF
      RS24=EXP(REAL(C00223(I00014,I00007,I00002)))
      RS25=2
      IF(RS24.GT.0.0) THEN
        RS26=RS24**RS25
      ELSE IF(RS24.EQ.0.0 .AND. RS25.GT.0.0) THEN
        RS26=0.0
      ELSE IF(RS24.EQ.0.0 .AND. RS25.EQ.0.0) THEN
        RS26=1.0
        IER=11
      ELSE IF(RS24.EQ.0.0 .AND. RS25.LT.0.0) THEN
        RS26=1.0
        IER=12
      ELSE
        IF(RS25.EQ.0.0) THEN
          RS26=1.0
          IER=13
        ELSE IF(INT(RS25).EQ.RS25) THEN
          RS26=RS24**INT(RS25)
        ELSE
          RS26=1.0
          IER=14
        END IF
      END IF
      RS27=RS23
      RS28=RS26
      IF(RS28.NE.0.0) THEN
        RS29=RS27/RS28
      ELSE
        RS29=1.0
        IER=2
      END IF
      ENTRY=RS14*(RS17*2  *(RS20)*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))*
     *  C00223(I00014,I00007,I00002)-(RS29)*
     *  EXP(REAL(C00223(I00014,I00007,I00002)))*
     *  C00223(I00014,I00007,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00014+SSZ(4)*(I00007-1+SSZ(3)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(228),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(200),COLBF(228),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "p_aUCONSUSA"',
     *  ' in equation "E_aEPSINUSAEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01150')
      RETURN
      END
      SUBROUTINE S01151(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,C00069,C00223,C00234,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      INTEGER I00017
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15,RS16,RS17
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00223(SSZ(4),SSZ(3),SSZ(2))
      REAL C00234(SSZ(30),SSZ(4),SSZ(3),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 "p_aQUSAEV"',
     *  ' in equation "E_aEPSINUSAEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aQUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      232)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00007=1,SSZ(3)
      DO     3 I00014=1,SSZ(4)
      RWN=RWN+1
      RS1=0.0
      DO 4 I00017=1,SSZ(30)
      RS2=REAL(C00234(I00017,I00014,I00007,I00002)-
     *  C00069(I00017,SSMP(SSMPST(1)-1+I00002)))
      IF(RS2.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      RS1=RS1+(C00068(I00017,SSMP(SSMPST(1)-1+I00002))-
     *  C00067(I00017,SSMP(SSMPST(1)-1+I00002)))*LOG(RS2)
    4 CONTINUE
      DO 5 I00001=1,SSZ(30)
      RS3=1  +EXP(REAL(C00223(I00014,I00007,I00002)))
      RS4=2
      IF(RS3.GT.0.0) THEN
        RS5=RS3**RS4
      ELSE IF(RS3.EQ.0.0 .AND. RS4.GT.0.0) THEN
        RS5=0.0
      ELSE IF(RS3.EQ.0.0 .AND. RS4.EQ.0.0) THEN
        RS5=1.0
        IER=11
      ELSE IF(RS3.EQ.0.0 .AND. RS4.LT.0.0) THEN
        RS5=1.0
        IER=12
      ELSE
        IF(RS4.EQ.0.0) THEN
          RS5=1.0
          IER=13
        ELSE IF(INT(RS4).EQ.RS4) THEN
          RS5=RS3**INT(RS4)
        ELSE
          RS5=1.0
          IER=14
        END IF
      END IF
      RS6=RS5
      RS7=EXP(REAL(C00223(I00014,I00007,I00002)))
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS9=RS1-(RS8)
      RS10=2
      IF(RS9.GT.0.0) THEN
        RS11=RS9**RS10
      ELSE IF(RS9.EQ.0.0 .AND. RS10.GT.0.0) THEN
        RS11=0.0
      ELSE IF(RS9.EQ.0.0 .AND. RS10.EQ.0.0) THEN
        RS11=1.0
        IER=11
      ELSE IF(RS9.EQ.0.0 .AND. RS10.LT.0.0) THEN
        RS11=1.0
        IER=12
      ELSE
        IF(RS10.EQ.0.0) THEN
          RS11=1.0
          IER=13
        ELSE IF(INT(RS10).EQ.RS10) THEN
          RS11=RS9**INT(RS10)
        ELSE
          RS11=1.0
          IER=14
        END IF
      END IF
      RS12=1.0
      RS13=RS11
      IF(RS13.NE.0.0) THEN
        RS14=RS12/RS13
      ELSE
        RS14=1.0
        IER=2
      END IF
      RS15=RS14*(C00068(I00001,SSMP(SSMPST(1)-1+I00002))-
     *  C00067(I00001,SSMP(SSMPST(1)-1+I00002)))
      RS16=C00234(I00001,I00014,I00007,I00002)-
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002))
      IF(RS16.NE.0.0) THEN
        RS17=RS15/RS16
      ELSE
        RS17=1.0
        IER=2
      END IF
      ENTRY=RS17*C00234(I00001,I00014,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(30)*(I00014-1+SSZ(4)*(I00007-1+SSZ(3)*(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
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(200),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
    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 "p_aQUSAEV"',
     *  ' in equation "E_aEPSINUSAEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01151')
      RETURN
      END
      SUBROUTINE S01154(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00234,C00235,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00069(SSZ(30),SSZ(1))
      REAL C00234(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00235(SSZ(30),SSZ(4),SSZ(3),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 "p_aQUSAEV"',
     *  ' in equation "aPRIVATEUSAEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aQUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      232)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00007=1,SSZ(3)
      DO     3 I00014=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00001=1,SSZ(30)
      RS1=C00235(I00001,I00014,I00007,I00002)
      RS2=C00234(I00001,I00014,I00007,I00002)-
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00234(I00001,I00014,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(30)*(I00014-1+SSZ(4)*(I00007-1+SSZ(3)*(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
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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
    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 "p_aQUSAEV"',
     *  ' in equation "aPRIVATEUSAEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01154')
      RETURN
      END
      SUBROUTINE S01155(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00234,C00235,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00014
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00069(SSZ(30),SSZ(1))
      REAL C00234(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL C00235(SSZ(30),SSZ(4),SSZ(3),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 "p_aPHIUSAEV"',
     *  ' in equation "aPRIVATEUSAEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aPHIUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      233)
      DO     1 I00002=1,SSZ(2)
      DO     2 I00007=1,SSZ(3)
      DO     3 I00014=1,SSZ(4)
      RWN=RWN+1
      DO 4 I00001=1,SSZ(30)
      RS1=REAL(C00234(I00001,I00014,I00007,I00002)-
     *  C00069(I00001,SSMP(SSMPST(1)-1+I00002)))
      IF(RS1.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      ENTRY=LOG(RS1)*C00235(I00001,I00014,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(30)*(I00014-1+SSZ(4)*(I00007-1+SSZ(3)*(I00002-
     *  1)))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(233),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(201),COLBF(233),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "p_aPHIUSAEV"',
     *  ' in equation "aPRIVATEUSAEV"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01155')
      RETURN
      END
      SUBROUTINE S01158(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,C00069,C00240,C00241,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00015
      INTEGER I00017
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15,RS16,RS17
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00067(SSZ(30),SSZ(1))
      REAL C00068(SSZ(30),SSZ(1))
      REAL C00069(SSZ(30),SSZ(1))
      REAL C00240(SSZ(39),SSZ(40))
      REAL C00241(SSZ(39),SSZ(30),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "p_aQPUP"',
     *  ' in equation "E_aEPSINUP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aQPUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      236)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00017=1,SSZ(30)
      RS2=REAL(C00241(I00015,I00017,I00002)-
     *  C00069(I00017,SSMP(SSMPST(38)-1+I00002)))
      IF(RS2.LE.0.0) THEN
        IER=32
        CALL TGIER(' ',IER,ERRMES)
        GOTO 15000
      END IF
      RS1=RS1+(C00068(I00017,SSMP(SSMPST(38)-1+I00002))-
     *  C00067(I00017,SSMP(SSMPST(38)-1+I00002)))*LOG(RS2)
    3 CONTINUE
      DO 4 I00001=1,SSZ(30)
      RS3=1  +EXP(REAL(C00240(I00015,I00002)))
      RS4=2
      IF(RS3.GT.0.0) THEN
        RS5=RS3**RS4
      ELSE IF(RS3.EQ.0.0 .AND. RS4.GT.0.0) THEN
        RS5=0.0
      ELSE IF(RS3.EQ.0.0 .AND. RS4.EQ.0.0) THEN
        RS5=1.0
        IER=11
      ELSE IF(RS3.EQ.0.0 .AND. RS4.LT.0.0) THEN
        RS5=1.0
        IER=12
      ELSE
        IF(RS4.EQ.0.0) THEN
          RS5=1.0
          IER=13
        ELSE IF(INT(RS4).EQ.RS4) THEN
          RS5=RS3**INT(RS4)
        ELSE
          RS5=1.0
          IER=14
        END IF
      END IF
      RS6=RS5
      RS7=EXP(REAL(C00240(I00015,I00002)))
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS9=RS1-(RS8)
      RS10=2
      IF(RS9.GT.0.0) THEN
        RS11=RS9**RS10
      ELSE IF(RS9.EQ.0.0 .AND. RS10.GT.0.0) THEN
        RS11=0.0
      ELSE IF(RS9.EQ.0.0 .AND. RS10.EQ.0.0) THEN
        RS11=1.0
        IER=11
      ELSE IF(RS9.EQ.0.0 .AND. RS10.LT.0.0) THEN
        RS11=1.0
        IER=12
      ELSE
        IF(RS10.EQ.0.0) THEN
          RS11=1.0
          IER=13
        ELSE IF(INT(RS10).EQ.RS10) THEN
          RS11=RS9**INT(RS10)
        ELSE
          RS11=1.0
          IER=14
        END IF
      END IF
      RS12=1.0
      RS13=RS11
      IF(RS13.NE.0.0) THEN
        RS14=RS12/RS13
      ELSE
        RS14=1.0
        IER=2
      END IF
      RS15=RS14*(C00068(I00001,SSMP(SSMPST(38)-1+I00002))-
     *  C00067(I00001,SSMP(SSMPST(38)-1+I00002)))
      RS16=C00241(I00015,I00001,I00002)-C00069(I00001,SSMP(SSMPST(38)-1+
     *  I00002))
      IF(RS16.NE.0.0) THEN
        RS17=RS15/RS16
      ELSE
        RS17=1.0
        IER=2
      END IF
      ENTRY=RS17*C00241(I00015,I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(I00001-1+SSZ(30)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(236),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(204),COLBF(236),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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_aQPUP"',
     *  ' in equation "E_aEPSINUP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01158')
      RETURN
      END
      SUBROUTINE S01160(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00241,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00069(SSZ(30),SSZ(1))
      REAL C00241(SSZ(39),SSZ(30),SSZ(40))
      REAL C00242(SSZ(39),SSZ(30),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "p_aQPUP"',
     *  ' in equation "aPRIVATEUUP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aQPUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      236)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(30)
      RS1=C00242(I00015,I00001,I00002)
      RS2=C00241(I00015,I00001,I00002)-C00069(I00001,SSMP(SSMPST(38)-1+
     *  I00002))
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IER=2
      END IF
      ENTRY=RS3*C00241(I00015,I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(I00001-1+SSZ(30)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(236),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(205),COLBF(236),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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_aQPUP"',
     *  ' in equation "aPRIVATEUUP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01160')
      RETURN
      END
      SUBROUTINE S01161(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00249,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00249(SSZ(39),SSZ(30),SSZ(30),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "p_aPP"',
     *  ' in equation "PRIVDMNDS2UP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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_aPP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       59)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00001=1,SSZ(30)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      DO 4 I00007=1,SSZ(30)
      ENTRY=-C00249(I00015,I00001,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00007+SSZ(30)*(SSMP(SSMPST(38)-1+I00002)-1)
        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
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(206),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
    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 "p_aPP"',
     *  ' in equation "PRIVDMNDS2UP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01161')
      RETURN
      END
      SUBROUTINE S01164(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "POVREALLAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(26)-1+
     *  SSMP(SSMPST(28)-1+SSMP(SSMPST(37)-1+1)))))+SSZ(12)*
     *  (SSMP(SSMPST(38)-1+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(207),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 "POVREALLAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01164')
      RETURN
      END
      SUBROUTINE S01165(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00253(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ato"',
     *  ' in equation "POVREALLAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-C00253(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(26)-1+
     *  SSMP(SSMPST(28)-1+SSMP(SSMPST(37)-1+1)))))+SSZ(12)*
     *  (SSMP(SSMPST(38)-1+I00002)-1)
        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(207),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
    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 "ato"',
     *  ' in equation "POVREALLAND"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "povinc"',
     *  ' in equation "POVREALLAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'povinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      242)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(SSMP(SSMPST(39)-1+1)-1+SSZ(38)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(242),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(207),COLBF(242),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "povinc"',
     *  ' in equation "POVREALLAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01167')
      RETURN
      END
      SUBROUTINE S01168(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmagr"',
     *  ' in equation "POVREALAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(41)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+I00002)-
     *  1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),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(208),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pmagr"',
     *  ' in equation "POVREALAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01168')
      RETURN
      END
      SUBROUTINE S01169(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00253(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ato"',
     *  ' in equation "POVREALAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-C00253(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  SSMP(SSMPST(41)-1+1))))+SSZ(12)*(SSMP(SSMPST(38)-1+I00002)-1)
        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(208),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
    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 "ato"',
     *  ' in equation "POVREALAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01169')
      RETURN
      END
      SUBROUTINE S01171(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "povinc"',
     *  ' in equation "POVREALAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'povinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      242)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(SSMP(SSMPST(40)-1+1)-1+SSZ(38)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(242),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(208),COLBF(242),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "povinc"',
     *  ' in equation "POVREALAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01171')
      RETURN
      END
      SUBROUTINE S01172(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmagr"',
     *  ' in equation "POVREALAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(43)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+I00002)-
     *  1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),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(209),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pmagr"',
     *  ' in equation "POVREALAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01172')
      RETURN
      END
      SUBROUTINE S01173(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00253(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ato"',
     *  ' in equation "POVREALAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-C00253(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  SSMP(SSMPST(43)-1+1))))+SSZ(12)*(SSMP(SSMPST(38)-1+I00002)-1)
        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(209),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
    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 "ato"',
     *  ' in equation "POVREALAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01173')
      RETURN
      END
      SUBROUTINE S01175(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "povinc"',
     *  ' in equation "POVREALAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'povinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      242)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(SSMP(SSMPST(42)-1+1)-1+SSZ(38)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(242),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(209),COLBF(242),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "povinc"',
     *  ' in equation "POVREALAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01175')
      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''',
     *    'usFINCOMEEQNOFF',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(140),KZC,DOEQ,STRHS,STRHNZ,
     *  C00222,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(218),ECHO1,
     *  ROWBF(188),COLBF(218),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(2),1,1,1,1,C00216,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01127(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(221),KZC,DOEQ,STRHS,STRHNZ,
     *  C00219,C00222,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'REALFARMINCOME',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(38),ECHO1,
     *  ROWBF(189),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(213),ECHO1,
     *  ROWBF(189),COLBF(213),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(222),ECHO1,
     *  ROWBF(189),COLBF(222),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''',
     *    'REALFINCOMEON',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(38),ECHO1,
     *  ROWBF(190),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(214),ECHO1,
     *  ROWBF(190),COLBF(214),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(223),ECHO1,
     *  ROWBF(190),COLBF(223),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''',
     *    'REALFINCOMEOFF',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(38),ECHO1,
     *  ROWBF(191),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(215),ECHO1,
     *  ROWBF(191),COLBF(215),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(224),ECHO1,
     *  ROWBF(191),COLBF(224),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_aPHIUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01137(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(228),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,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(230),ECHO1,
     *  ROWBF(195),COLBF(230),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_aEPSINUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01139(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(228),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,C00069,C00223,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 S01140(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(229),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,C00069,C00223,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(231),ECHO1,
     *  ROWBF(196),COLBF(231),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(2),1,1,1,1,C00226,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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''',
     *    'aPRIVATEUSA',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(228),ECHO1,
     *  ROWBF(197),COLBF(228),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(2),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01143(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(229),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00224,C00225,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01144(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(230),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00224,C00225,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'PRIVDMNDSUSA',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(59),KZC,DOEQ,STRHS,STRHNZ,
     *  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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(219),ECHO1,
     *  ROWBF(198),COLBF(219),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(30),SSZ(4),SSZ(3),SSZ(2),1,1,1,C00231,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(229),ECHO1,
     *  ROWBF(198),COLBF(229),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_aPHIUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01148(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(228),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,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(233),ECHO1,
     *  ROWBF(199),COLBF(233),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_aEPSINUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01150(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(228),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,C00069,C00223,C00234,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01151(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(232),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,C00069,C00223,C00234,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(200),COLBF(234),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(2),1,1,1,1,C00236,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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''',
     *    'aPRIVATEUSAEV',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(228),ECHO1,
     *  ROWBF(201),COLBF(228),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(4),SSZ(3),SSZ(2),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01154(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(232),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00234,C00235,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01155(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(233),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00234,C00235,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'PRIVDMNDSUSAEV',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(232),ECHO1,
     *  ROWBF(202),COLBF(232),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(235),ECHO1,
     *  ROWBF(202),COLBF(235),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(30),SSZ(4),SSZ(3),SSZ(2),1,1,1,C00239,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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_aEPSINUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01158(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(236),KZC,DOEQ,STRHS,STRHNZ,
     *  C00067,C00068,C00069,C00240,C00241,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(204),COLBF(238),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(39),SSZ(40),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'aPRIVATEUUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01160(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(236),KZC,DOEQ,STRHS,STRHNZ,
     *  C00069,C00241,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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVDMNDS2UP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01161(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(59),KZC,DOEQ,STRHS,STRHNZ,
     *  C00249,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(206),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(239),ECHO1,
     *  ROWBF(206),COLBF(239),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(39),SSZ(30),SSZ(40),1,1,1,1,C00248,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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''',
     *    'POVREALLAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01164(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 S01165(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(239),ECHO1,
     *  ROWBF(207),COLBF(239),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 S01167(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(242),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''',
     *    'POVREALAGUNSK',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01168(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(21),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 S01169(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(239),ECHO1,
     *  ROWBF(208),COLBF(239),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 S01171(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(242),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''',
     *    'POVREALAGSK',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01172(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(21),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 S01173(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(239),ECHO1,
     *  ROWBF(209),COLBF(239),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 S01175(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(242),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('M00028')
      RETURN
      END
      SUBROUTINE S01176(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmnagr"',
     *  ' in equation "POVREALNAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmnagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(41)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(210),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 "pmnagr"',
     *  ' in equation "POVREALNAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01176')
      RETURN
      END
      SUBROUTINE S01177(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00253(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ato"',
     *  ' in equation "POVREALNAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-C00253(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  SSMP(SSMPST(41)-1+1))))+SSZ(12)*(SSMP(SSMPST(38)-1+I00002)-1)
        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(210),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
    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 "ato"',
     *  ' in equation "POVREALNAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01177')
      RETURN
      END
      SUBROUTINE S01179(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "povinc"',
     *  ' in equation "POVREALNAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'povinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      242)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(SSMP(SSMPST(44)-1+1)-1+SSZ(38)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(242),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(210),COLBF(242),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "povinc"',
     *  ' in equation "POVREALNAGUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01179')
      RETURN
      END
      SUBROUTINE S01180(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmnagr"',
     *  ' in equation "POVREALNAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmnagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(43)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(211),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 "pmnagr"',
     *  ' in equation "POVREALNAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01180')
      RETURN
      END
      SUBROUTINE S01181(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00253(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ato"',
     *  ' in equation "POVREALNAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-C00253(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  SSMP(SSMPST(43)-1+1))))+SSZ(12)*(SSMP(SSMPST(38)-1+I00002)-1)
        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(211),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
    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 "ato"',
     *  ' in equation "POVREALNAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01181')
      RETURN
      END
      SUBROUTINE S01183(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "povinc"',
     *  ' in equation "POVREALNAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'povinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      242)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(SSMP(SSMPST(45)-1+1)-1+SSZ(38)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(242),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(211),COLBF(242),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "povinc"',
     *  ' in equation "POVREALNAGSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01183')
      RETURN
      END
      SUBROUTINE S01184(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "POVREALWUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  SSMP(SSMPST(41)-1+1))))+SSZ(12)*(SSMP(SSMPST(38)-1+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(212),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 "POVREALWUNSK"',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,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00253(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ato"',
     *  ' in equation "POVREALWUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-C00253(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  SSMP(SSMPST(41)-1+1))))+SSZ(12)*(SSMP(SSMPST(38)-1+I00002)-1)
        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(212),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
    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 "ato"',
     *  ' in equation "POVREALWUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01185')
      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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "povinc"',
     *  ' in equation "POVREALWUNSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'povinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      242)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(SSMP(SSMPST(46)-1+1)-1+SSZ(38)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(242),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(242),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "povinc"',
     *  ' in equation "POVREALWUNSK"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "POVREALWSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  SSMP(SSMPST(43)-1+1))))+SSZ(12)*(SSMP(SSMPST(38)-1+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(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
    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 "POVREALWSK"',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,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00253(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ato"',
     *  ' in equation "POVREALWSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-C00253(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  SSMP(SSMPST(43)-1+1))))+SSZ(12)*(SSMP(SSMPST(38)-1+I00002)-1)
        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(213),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
    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 "ato"',
     *  ' in equation "POVREALWSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01189')
      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 I00002
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "povinc"',
     *  ' in equation "POVREALWSK"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'povinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      242)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(SSMP(SSMPST(47)-1+1)-1+SSZ(38)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(242),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(242),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "povinc"',
     *  ' in equation "POVREALWSK"',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmagr"',
     *  ' in equation "POVREALAGCAP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(36)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+I00002)-
     *  1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),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(214),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pmagr"',
     *  ' in equation "POVREALAGCAP"',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,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00253(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ato"',
     *  ' in equation "POVREALAGCAP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-C00253(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(29)-1+1)))+
     *  SSZ(12)*(SSMP(SSMPST(38)-1+I00002)-1)
        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(214),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
    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 "ato"',
     *  ' in equation "POVREALAGCAP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01193')
      RETURN
      END
      SUBROUTINE S01195(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "povinc"',
     *  ' in equation "POVREALAGCAP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'povinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      242)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(SSMP(SSMPST(48)-1+1)-1+SSZ(38)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(242),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(214),COLBF(242),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "povinc"',
     *  ' in equation "POVREALAGCAP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01195')
      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 I00002
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmnagr"',
     *  ' in equation "POVREALNAGCAP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmnagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(36)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(215),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 "pmnagr"',
     *  ' in equation "POVREALNAGCAP"',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,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00253(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ato"',
     *  ' in equation "POVREALNAGCAP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ato',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      111)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-C00253(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(29)-1+1)))+
     *  SSZ(12)*(SSMP(SSMPST(38)-1+I00002)-1)
        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(215),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
    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 "ato"',
     *  ' in equation "POVREALNAGCAP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01197')
      RETURN
      END
      SUBROUTINE S01199(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "povinc"',
     *  ' in equation "POVREALNAGCAP"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'povinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      242)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(SSMP(SSMPST(49)-1+1)-1+SSZ(38)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(242),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(242),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "povinc"',
     *  ' in equation "POVREALNAGCAP"',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 I00002
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "y"',
     *  ' in equation "POVREALTRANSF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       31)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(216),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 "y"',
     *  ' in equation "POVREALTRANSF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01200')
      RETURN
      END
      SUBROUTINE S01202(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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "povinc"',
     *  ' in equation "POVREALTRANSF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'povinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      242)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(SSMP(SSMPST(50)-1+1)-1+SSZ(38)*(I00002-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(242),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(242),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "povinc"',
     *  ' in equation "POVREALTRANSF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01202')
      RETURN
      END
      SUBROUTINE S01204(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00252,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "povinc"',
     *  ' in equation "POVCHNG_STRATA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'povinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      242)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      DO 4 I00001=1,SSZ(38)
      ENTRY=(C00250(I00015,I00002,I00007)/100.)*
     *  C00252(I00015,I00001,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(I00001-1+SSZ(38)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(242),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(217),COLBF(242),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "povinc"',
     *  ' in equation "POVCHNG_STRATA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01204')
      RETURN
      END
      SUBROUTINE S01207(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfdland"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(40)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(26)-1+
     *  SSMP(SSMPST(28)-1+SSMP(SSMPST(37)-1+1)))))+SSZ(12)*
     *  (SSMP(SSMPST(38)-1+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(219),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 "pfdland"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01207')
      RETURN
      END
      SUBROUTINE S01208(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfact"',
     *  ' in equation "pfdland"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(39)-1+1)+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(219),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "pfdland"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01208')
      RETURN
      END
      SUBROUTINE S01209(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmagr"',
     *  ' in equation "pfduag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(41)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+I00002)-
     *  1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),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(220),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pmagr"',
     *  ' in equation "pfduag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01209')
      RETURN
      END
      SUBROUTINE S01210(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfact"',
     *  ' in equation "pfduag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(40)-1+1)+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(220),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "pfduag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01210')
      RETURN
      END
      SUBROUTINE S01211(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmagr"',
     *  ' in equation "pfdsag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(43)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+I00002)-
     *  1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),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(221),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pmagr"',
     *  ' in equation "pfdsag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01211')
      RETURN
      END
      SUBROUTINE S01212(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfact"',
     *  ' in equation "pfdsag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(42)-1+1)+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(221),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "pfdsag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01212')
      RETURN
      END
      SUBROUTINE S01213(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmnagr"',
     *  ' in equation "pfdunag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmnagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(41)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(222),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 "pmnagr"',
     *  ' in equation "pfdunag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01213')
      RETURN
      END
      SUBROUTINE S01214(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfact"',
     *  ' in equation "pfdunag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(44)-1+1)+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(222),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "pfdunag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01214')
      RETURN
      END
      SUBROUTINE S01215(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmnagr"',
     *  ' in equation "pfdsnag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmnagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(43)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(223),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 "pmnagr"',
     *  ' in equation "pfdsnag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01215')
      RETURN
      END
      SUBROUTINE S01216(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfact"',
     *  ' in equation "pfdsnag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(45)-1+1)+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(223),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "pfdsnag"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01216')
      RETURN
      END
      SUBROUTINE S01217(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfdswg"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(40)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  SSMP(SSMPST(41)-1+1))))+SSZ(12)*(SSMP(SSMPST(38)-1+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(224),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 "pfdswg"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01217')
      RETURN
      END
      SUBROUTINE S01218(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfact"',
     *  ' in equation "pfdswg"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(46)-1+1)+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(224),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "pfdswg"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01218')
      RETURN
      END
      SUBROUTINE S01219(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfdswg2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(40)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(27)-1+
     *  SSMP(SSMPST(43)-1+1))))+SSZ(12)*(SSMP(SSMPST(38)-1+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(225),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 "pfdswg2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01219')
      RETURN
      END
      SUBROUTINE S01220(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfact"',
     *  ' in equation "pfdswg2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(47)-1+1)+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(225),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "pfdswg2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01220')
      RETURN
      END
      SUBROUTINE S01221(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmagr"',
     *  ' in equation "pfdagcap"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       21)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(36)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+I00002)-
     *  1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(21),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(226),COLBF(21),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pmagr"',
     *  ' in equation "pfdagcap"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01221')
      RETURN
      END
      SUBROUTINE S01222(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfact"',
     *  ' in equation "pfdagcap"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(48)-1+1)+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(226),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "pfdagcap"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01222')
      RETURN
      END
      SUBROUTINE S01223(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pmnagr"',
     *  ' in equation "pfdagcap2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmnagr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(36)-1+1)+SSZ(28)*(SSMP(SSMPST(38)-1+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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(227),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 "pmnagr"',
     *  ' in equation "pfdagcap2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01223')
      RETURN
      END
      SUBROUTINE S01224(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfact"',
     *  ' in equation "pfdagcap2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(49)-1+1)+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "pfdagcap2"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01224')
      RETURN
      END
      SUBROUTINE S01225(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "y"',
     *  ' in equation "pftrans"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       31)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(228),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "pftrans"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01225')
      RETURN
      END
      SUBROUTINE S01226(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 RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 "pfact"',
     *  ' in equation "pftrans"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      RWN=RWN+1
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(50)-1+1)+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "pftrans"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01226')
      RETURN
      END
      SUBROUTINE M00029(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''',
     *    'POVREALNAGUNSK',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01176(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),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 S01177(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(239),ECHO1,
     *  ROWBF(210),COLBF(239),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 S01179(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(242),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''',
     *    'POVREALNAGSK',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01180(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),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 S01181(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(239),ECHO1,
     *  ROWBF(211),COLBF(239),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 S01183(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(242),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''',
     *    'POVREALWUNSK',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(239),ECHO1,
     *  ROWBF(212),COLBF(239),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 S01187(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(242),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''',
     *    'POVREALWSK',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,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(239),ECHO1,
     *  ROWBF(213),COLBF(239),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 S01191(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(242),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''',
     *    'POVREALAGCAP',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(21),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 S01193(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(239),ECHO1,
     *  ROWBF(214),COLBF(239),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 S01195(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(242),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''',
     *    'POVREALNAGCAP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01196(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),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 S01197(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(111),KZC,DOEQ,STRHS,STRHNZ,
     *  C00253,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(239),ECHO1,
     *  ROWBF(215),COLBF(239),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 S01199(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(242),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''',
     *    'POVREALTRANSF',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01200(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),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(239),ECHO1,
     *  ROWBF(216),COLBF(239),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 S01202(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(242),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''',
     *    'POVCHNG_STRATA',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(240),ECHO1,
     *  ROWBF(217),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01204(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(242),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00252,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'POVCHNG_REG',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(240),ECHO1,
     *  ROWBF(218),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(241),ECHO1,
     *  ROWBF(218),COLBF(241),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''',
     *    'pfdland',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01207(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 S01208(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),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''',
     *    'pfduag',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01209(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(21),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 S01210(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),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''',
     *    'pfdsag',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01211(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(21),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 S01212(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),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''',
     *    'pfdunag',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01213(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),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 S01214(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),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''',
     *    'pfdsnag',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01215(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),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 S01216(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),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''',
     *    'pfdswg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01217(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 S01218(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),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''',
     *    'pfdswg2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01219(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 S01220(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),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''',
     *    'pfdagcap',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01221(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(21),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 S01222(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),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''',
     *    'pfdagcap2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01223(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(22),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 S01224(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),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''',
     *    'pftrans',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01225(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),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 S01226(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),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('M00029')
      RETURN
      END
      SUBROUTINE S01227(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00252,C00255,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      REAL C00255(SSZ(39),SSZ(37),SSZ(40))
      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 "C_STRATA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       31)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      RS1=0.0
      DO 4 I00001=1,SSZ(38)
      RS1=RS1+(C00250(I00015,I00002,I00007)/100.)*
     *  C00252(I00015,I00001,I00007,I00002)
    4 CONTINUE
      ENTRY=-(RS1-(C00250(I00015,I00002,I00007)/100.)*
     *  C00255(I00015,I00007,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(229),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "C_STRATA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01227')
      RETURN
      END
      SUBROUTINE S01228(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00256,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00256(SSZ(39),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "toreplace"',
     *  ' in equation "C_STRATA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'toreplace',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      138)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=(C00250(I00015,I00002,I00007)/100.)*
     *  C00256(I00015,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(138),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(138),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "toreplace"',
     *  ' in equation "C_STRATA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01228')
      RETURN
      END
      SUBROUTINE S01229(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00255,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00255(SSZ(39),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "truecost"',
     *  ' in equation "C_STRATA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'truecost',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      239)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=(-C00250(I00015,I00002,I00007)/100.)*
     *  C00255(I00015,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(239),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(239),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "truecost"',
     *  ' in equation "C_STRATA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01229')
      RETURN
      END
      SUBROUTINE S01230(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00252,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfact"',
     *  ' in equation "C_STRATA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      DO 4 I00001=1,SSZ(38)
      ENTRY=(C00250(I00015,I00002,I00007)/100.)*
     *  C00252(I00015,I00001,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(229),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "C_STRATA"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01230')
      RETURN
      END
      SUBROUTINE S01232(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00252,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      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 "CNTEarn"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       31)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      RS1=0.0
      DO 4 I00001=1,SSZ(38)
      RS1=RS1+(C00250(I00015,I00002,I00007)/100.)*
     *  C00252(I00015,I00001,I00007,I00002)
    4 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "CNTEarn"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01232')
      RETURN
      END
      SUBROUTINE S01233(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00252,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfact"',
     *  ' in equation "CNTEarn"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      DO 4 I00001=1,SSZ(38)
      ENTRY=(C00250(I00015,I00002,I00007)/100.)*
     *  C00252(I00015,I00001,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(230),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "CNTEarn"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01233')
      RETURN
      END
      SUBROUTINE S01235(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00256,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00256(SSZ(39),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "toreplace"',
     *  ' in equation "CNTTax"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'toreplace',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      138)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=(C00250(I00015,I00002,I00007)/100.)*
     *  C00256(I00015,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(138),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(138),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "toreplace"',
     *  ' in equation "CNTTax"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01235')
      RETURN
      END
      SUBROUTINE S01237(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00255,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00255(SSZ(39),SSZ(37),SSZ(40))
      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 "CNTCOL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       31)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=(C00250(I00015,I00002,I00007)/100.)*
     *  C00255(I00015,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(232),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "CNTCOL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01237')
      RETURN
      END
      SUBROUTINE S01238(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00255,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL C00255(SSZ(39),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "truecost"',
     *  ' in equation "CNTCOL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'truecost',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      239)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=(-C00250(I00015,I00002,I00007)/100.)*
     *  C00255(I00015,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(239),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(232),COLBF(239),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "truecost"',
     *  ' in equation "CNTCOL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01238')
      RETURN
      END
      SUBROUTINE S01240(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,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 I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00251(SSZ(39),SSZ(40))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      REAL C00254(SSZ(39),SSZ(37),SSZ(40))
      REAL C00257(SSZ(39),SSZ(40))
      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 "c_HCREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       31)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00007=1,SSZ(37)
      RS2=0.0
      DO 4 I00001=1,SSZ(38)
      RS2=RS2+C00252(I00015,I00001,I00007,I00002)
    4 CONTINUE
      RS1=RS1+(C00251(I00015,I00002)/100.)*C00254(I00015,I00007,I00002)*
     *  RS2
    3 CONTINUE
      ENTRY=-(RS1-(C00251(I00015,I00002)/100.)*C00257(I00015,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(233),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 "y"',
     *  ' in equation "c_HCREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01240')
      RETURN
      END
      SUBROUTINE S01241(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00258,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00251(SSZ(39),SSZ(40))
      REAL C00258(SSZ(39),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "toreplace"',
     *  ' in equation "c_HCREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'toreplace',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      138)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=(C00251(I00015,I00002)/100.)*C00258(I00015,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(138),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(233),COLBF(138),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "toreplace"',
     *  ' in equation "c_HCREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01241')
      RETURN
      END
      SUBROUTINE S01242(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,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 I00002
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00251(SSZ(39),SSZ(40))
      REAL C00257(SSZ(39),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "truecost"',
     *  ' in equation "c_HCREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'truecost',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      239)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=(-C00251(I00015,I00002)/100.)*C00257(I00015,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(239),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(233),COLBF(239),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "truecost"',
     *  ' in equation "c_HCREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01242')
      RETURN
      END
      SUBROUTINE S01243(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00251(SSZ(39),SSZ(40))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      REAL C00254(SSZ(39),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfact"',
     *  ' in equation "c_HCREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(38)
      RS1=0.0
      DO 4 I00007=1,SSZ(37)
      RS1=RS1+(-C00251(I00015,I00002)/100.)*
     *  C00254(I00015,I00007,I00002)*C00252(I00015,I00001,I00007,I00002)
    4 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(233),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "c_HCREG"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01243')
      RETURN
      END
      SUBROUTINE S01245(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00251(SSZ(39),SSZ(40))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      REAL C00254(SSZ(39),SSZ(37),SSZ(40))
      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 "RHCEarn"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       31)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      RS1=0.0
      DO 3 I00007=1,SSZ(37)
      RS2=0.0
      DO 4 I00001=1,SSZ(38)
      RS2=RS2+C00252(I00015,I00001,I00007,I00002)
    4 CONTINUE
      RS1=RS1+(C00251(I00015,I00002)/100.)*C00254(I00015,I00007,I00002)*
     *  RS2
    3 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),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 "y"',
     *  ' in equation "RHCEarn"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01245')
      RETURN
      END
      SUBROUTINE S01246(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00251(SSZ(39),SSZ(40))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      REAL C00254(SSZ(39),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfact"',
     *  ' in equation "RHCEarn"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      DO 3 I00001=1,SSZ(38)
      RS1=0.0
      DO 4 I00007=1,SSZ(37)
      RS1=RS1+(-C00251(I00015,I00002)/100.)*
     *  C00254(I00015,I00007,I00002)*C00252(I00015,I00001,I00007,I00002)
    4 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(234),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "RHCEarn"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01246')
      RETURN
      END
      SUBROUTINE S01248(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00258,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,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 I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00251(SSZ(39),SSZ(40))
      REAL C00258(SSZ(39),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "toreplace"',
     *  ' in equation "RHCTax"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'toreplace',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      138)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=(C00251(I00015,I00002)/100.)*C00258(I00015,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(138),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(235),COLBF(138),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "toreplace"',
     *  ' in equation "RHCTax"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01248')
      RETURN
      END
      SUBROUTINE S01250(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,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 I00002
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00251(SSZ(39),SSZ(40))
      REAL C00257(SSZ(39),SSZ(40))
      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 "RHCCOL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       31)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=(C00251(I00015,I00002)/100.)*C00257(I00015,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(236),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 "y"',
     *  ' in equation "RHCCOL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01250')
      RETURN
      END
      SUBROUTINE S01251(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,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 I00002
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00251(SSZ(39),SSZ(40))
      REAL C00257(SSZ(39),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "truecost"',
     *  ' in equation "RHCCOL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'truecost',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      239)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00015=1,SSZ(39)
      RWN=RWN+1
      ENTRY=(-C00251(I00015,I00002)/100.)*C00257(I00015,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00015+SSZ(39)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(239),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(236),COLBF(239),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "truecost"',
     *  ' in equation "RHCCOL"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01251')
      RETURN
      END
      SUBROUTINE S01253(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00251(SSZ(39),SSZ(40))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      REAL C00254(SSZ(39),SSZ(37),SSZ(40))
      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 "BYSTRAT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       31)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      RS1=0.0
      DO 4 I00001=1,SSZ(38)
      RS1=RS1+C00252(I00015,I00001,I00007,I00002)
    4 CONTINUE
      ENTRY=(-C00251(I00015,I00002)/100.)*C00254(I00015,I00007,I00002)*
     *  RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(237),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "BYSTRAT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01253')
      RETURN
      END
      SUBROUTINE S01254(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00251(SSZ(39),SSZ(40))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      REAL C00254(SSZ(39),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfact"',
     *  ' in equation "BYSTRAT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00007=1,SSZ(37)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      DO 4 I00001=1,SSZ(38)
      ENTRY=(C00251(I00015,I00002)/100.)*C00254(I00015,I00007,I00002)*
     *  C00252(I00015,I00001,I00007,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(237),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "BYSTRAT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01254')
      RETURN
      END
      SUBROUTINE S01256(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00251(SSZ(39),SSZ(40))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      REAL C00254(SSZ(39),SSZ(37),SSZ(40))
      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 "BYEINGS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'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(       31)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00001=1,SSZ(38)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      RS1=0.0
      DO 4 I00007=1,SSZ(37)
      RS1=RS1+(C00251(I00015,I00002)/100.)*C00254(I00015,I00007,I00002)*
     *  C00252(I00015,I00001,I00007,I00002)
    4 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00002)
        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
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(238),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 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 "BYEINGS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01256')
      RETURN
      END
      SUBROUTINE S01257(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00007
      INTEGER I00015
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL 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 C00251(SSZ(39),SSZ(40))
      REAL C00252(SSZ(39),SSZ(38),SSZ(37),SSZ(40))
      REAL C00254(SSZ(39),SSZ(37),SSZ(40))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfact"',
     *  ' in equation "BYEINGS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') RETURN
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) RETURN
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfact',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      243)
      DO     1 I00002=1,SSZ(40)
      DO     2 I00001=1,SSZ(38)
      DO     3 I00015=1,SSZ(39)
      RWN=RWN+1
      RS1=0.0
      DO 4 I00007=1,SSZ(37)
      RS1=RS1+(-C00251(I00015,I00002)/100.)*
     *  C00254(I00015,I00007,I00002)*C00252(I00015,I00001,I00007,I00002)
    4 CONTINUE
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(38)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(243),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(238),COLBF(243),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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 "pfact"',
     *  ' in equation "BYEINGS"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01257')
      RETURN
      END
      SUBROUTINE M00030(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''',
     *    'C_STRATA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01227(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00252,C00255,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01228(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(138),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00256,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01229(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(239),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00255,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01230(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00252,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(229),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''',
     *    'CNTEarn',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01232(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00252,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01233(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00252,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(245),ECHO1,
     *  ROWBF(230),COLBF(245),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''',
     *    'CNTTax',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01235(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(138),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00256,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(231),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''',
     *    'CNTCOL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01237(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00255,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01238(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(239),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,C00255,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(247),ECHO1,
     *  ROWBF(232),COLBF(247),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''',
     *    'c_HCREG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01240(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,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 S01241(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(138),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00258,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01242(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(239),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,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 S01243(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(248),ECHO1,
     *  ROWBF(233),COLBF(248),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''',
     *    'RHCEarn',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01245(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01246(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(249),ECHO1,
     *  ROWBF(234),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''',
     *    'RHCTax',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01248(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(138),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00258,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(250),ECHO1,
     *  ROWBF(235),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''',
     *    'RHCCOL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01250(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,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 S01251(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(239),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(251),ECHO1,
     *  ROWBF(236),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''',
     *    'BYSTRAT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01253(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01254(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(252),ECHO1,
     *  ROWBF(237),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''',
     *    'BYEINGS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01256(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S01257(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  KSTEP,SMND(243),KZC,DOEQ,STRHS,STRHNZ,
     *  C00251,C00252,C00254,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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(253),ECHO1,
     *  ROWBF(238),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
      RETURN
15000 CALL PERET('M00030')
      RETURN
      END
      SUBROUTINE S01259(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00038,V00221,V00227,
     *  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 V00038(SSZ(1))
      REAL V00221(SSZ(4),SSZ(3),SSZ(2))
      REAL V00227(SSZ(4),SSZ(3),SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "usyfrealoff"',
     *  ' using equation "usREALFINCOMEOFF"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(4)
      DO 2 I00004=1,SSZ(3)
      DO 3 I00002=1,SSZ(2)
      V00227(I00001,I00004,I00002)=(V00221(I00001,I00004,I00002)-
     *  V00038(SSMP(SSMPST(1)-1+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 "usyfrealoff"',
     *  ' using equation "usREALFINCOMEOFF"',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,
     *  V00038,V00220,V00226,
     *  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 V00038(SSZ(1))
      REAL V00220(SSZ(4),SSZ(3),SSZ(2))
      REAL V00226(SSZ(4),SSZ(3),SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "usyfrealon"',
     *  ' using equation "usREALFINCOMEON"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(4)
      DO 2 I00004=1,SSZ(3)
      DO 3 I00002=1,SSZ(2)
      V00226(I00001,I00004,I00002)=(V00220(I00001,I00004,I00002)-
     *  V00038(SSMP(SSMPST(1)-1+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 "usyfrealon"',
     *  ' using equation "usREALFINCOMEON"',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,
     *  V00038,V00219,V00225,
     *  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 V00038(SSZ(1))
      REAL V00219(SSZ(4),SSZ(3),SSZ(2))
      REAL V00225(SSZ(4),SSZ(3),SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR
      IER=0
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "usyfreal"',
     *  ' using equation "usREALFARMINCOME"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(4)
      DO 2 I00004=1,SSZ(3)
      DO 3 I00002=1,SSZ(2)
      V00225(I00001,I00004,I00002)=(V00219(I00001,I00004,I00002)-
     *  V00038(SSMP(SSMPST(1)-1+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 "usyfreal"',
     *  ' using equation "usREALFARMINCOME"',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,
     *  C00155,
     *  V00200,V00201,V00205,
     *  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 C00155(SSZ(5),SSZ(1))
      REAL V00200(SSZ(5),SSZ(1))
      REAL V00201(SSZ(5))
      REAL V00205(SSZ(5),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 "c3_ir"',
     *  ' using equation "c3_irEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      V00205(I00001,I00002)=C00155(I00001,I00002)*
     *  (V00200(I00001,I00002)-V00201(I00001))
    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 "c3_ir"',
     *  ' using equation "c3_irEQ"',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,
     *  C00151,
     *  V00199,V00201,V00204,
     *  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 C00151(SSZ(5),SSZ(1))
      REAL V00199(SSZ(5),SSZ(1))
      REAL V00201(SSZ(5))
      REAL V00204(SSZ(5),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 "c2_ir"',
     *  ' using equation "c2_irEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      V00204(I00001,I00002)=C00151(I00001,I00002)*
     *  (V00199(I00001,I00002)-V00201(I00001))
    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 "c2_ir"',
     *  ' using equation "c2_irEQ"',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,
     *  C00151,C00155,
     *  V00201,V00202,V00203,
     *  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 C00151(SSZ(5),SSZ(1))
      REAL C00155(SSZ(5),SSZ(1))
      REAL V00201(SSZ(5))
      REAL V00202(1)
      REAL V00203(SSZ(5),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 "c1_ir"',
     *  ' using equation "c1_irEQ"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      V00203(I00001,I00002)=(C00151(I00001,I00002)-
     *  C00155(I00001,I00002))*(V00201(I00001)-V00202(1))
    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 "c1_ir"',
     *  ' using equation "c1_irEQ"',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,
     *  V00005,V00038,V00163,
     *  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
      REAL V00005(SSZ(12),SSZ(1))
      REAL V00038(SSZ(1))
      REAL V00163(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 "pfactreal"',
     *  ' using equation "REALRETURN"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(9)
      DO 2 I00003=1,SSZ(1)
      V00163(I00001,I00003)=(V00005(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+
     *  I00001)),I00003)-V00038(I00003))
    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 "pfactreal"',
     *  ' using equation "REALRETURN"',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,
     *  V00014,V00171,V00172,
     *  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 V00014(SSZ(12),SSZ(1))
      REAL V00171(SSZ(1))
      REAL V00172(SSZ(10),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(10)
      DO 2 I00002=1,SSZ(1)
      V00172(I00001,I00002)=(V00014(SSMP(SSMPST(10)-1+I00001),I00002)-
     *  V00171(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('S01266')
      RETURN
      END
      SUBROUTINE S01267(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00114,C00116,C00117,C00348,
     *  V00005,V00028,V00123,V00124,V00130,V00131,V00132,V00133,
     *  V00137,
     *  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 C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL C00116(SSZ(5),SSZ(1),SSZ(1))
      REAL C00117(SSZ(5),SSZ(1),SSZ(1))
      REAL C00348(SSZ(5),SSZ(1),SSZ(1))
      REAL V00005(SSZ(12),SSZ(1))
      REAL V00028(SSZ(5),SSZ(1),SSZ(1))
      REAL V00123(SSZ(5),SSZ(1))
      REAL V00124(SSZ(5),SSZ(1),SSZ(1))
      REAL V00130(SSZ(5))
      REAL V00131(SSZ(5))
      REAL V00132(SSZ(1))
      REAL V00133(SSZ(1))
      REAL V00137(SSZ(6))
      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(5)
      RS1=0.0
      DO 4 I00005=1,SSZ(6)
      RS1=RS1+C00117(I00001,I00002,I00003)*
     *  C00114(I00005,I00001,I00002,I00003)*V00130(SSMP(SSMPST(2)-1+
     *  I00005))
    4 CONTINUE
      RS2=0.0
      DO 5 I00005=1,SSZ(6)
      RS2=RS2-C00117(I00001,I00002,I00003)*
     *  C00114(I00005,I00001,I00002,I00003)*V00137(I00005)
    5 CONTINUE
      V00028(I00001,I00002,I00003)=-(-C00116(I00001,I00002,I00003)*
     *  V00005(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001)),I00002)+
     *  C00116(I00001,I00002,I00003)*V00123(I00001,I00002)+
     *  C00116(I00001,I00002,I00003)*V00124(I00001,I00002,I00003)+RS1+
     *  C00348(I00001,I00002,I00003)*V00131(I00001)+
     *  C00348(I00001,I00002,I00003)*V00132(I00002)+
     *  C00348(I00001,I00002,I00003)*V00133(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('S01267')
      RETURN
      END
      SUBROUTINE S01268(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00129,V00130,V00131,V00132,V00133,
     *  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 V00129(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL V00130(SSZ(5))
      REAL V00131(SSZ(5))
      REAL V00132(SSZ(1))
      REAL V00133(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(6)
      DO 2 I00001=1,SSZ(5)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      V00129(I00005,I00001,I00002,I00003)=(V00130(SSMP(SSMPST(2)-1+
     *  I00005))+V00131(I00001)+V00132(I00002)+V00133(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('S01268')
      RETURN
      END
      SUBROUTINE S01269(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00114,
     *  V00129,V00135,V00137,
     *  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 C00114(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL V00129(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL V00135(SSZ(5),SSZ(1),SSZ(1))
      REAL V00137(SSZ(6))
      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(5)
      RS1=0.0
      DO 4 I00005=1,SSZ(6)
      RS1=RS1+C00114(I00005,I00001,I00002,I00003)*(V00137(I00005)-
     *  V00129(I00005,I00001,I00002,I00003))
    4 CONTINUE
      V00135(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('S01269')
      RETURN
      END
      SUBROUTINE S01270(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00027,V00128,V00129,
     *  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 V00027(SSZ(5),SSZ(1),SSZ(1))
      REAL V00128(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL V00129(SSZ(6),SSZ(5),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(6)
      DO 2 I00001=1,SSZ(5)
      DO 3 I00002=1,SSZ(1)
      DO 4 I00003=1,SSZ(1)
      V00128(I00005,I00001,I00002,I00003)=(V00027(I00001,I00002,I00003)-
     *  V00129(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('S01270')
      RETURN
      END
      SUBROUTINE S01271(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00026,V00028,V00125,V00126,
     *  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 V00026(SSZ(5),SSZ(1),SSZ(1))
      REAL V00028(SSZ(5),SSZ(1),SSZ(1))
      REAL V00125(SSZ(5),SSZ(1))
      REAL V00126(SSZ(5),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(5)
      DO 2 I00002=1,SSZ(1)
      DO 3 I00003=1,SSZ(1)
      V00026(I00001,I00002,I00003)=(V00125(I00001,I00003)+
     *  V00126(I00001,I00002,I00003)+V00028(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('S01271')
      RETURN
      END
      SUBROUTINE S01272(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00005,V00029,V00123,V00124,
     *  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(12),SSZ(1))
      REAL V00029(SSZ(5),SSZ(1),SSZ(1))
      REAL V00123(SSZ(5),SSZ(1))
      REAL V00124(SSZ(5),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(5)
      DO 2 I00002=1,SSZ(1)
      DO 3 I00003=1,SSZ(1)
      V00029(I00001,I00002,I00003)=(V00005(SSMP(SSMPST(10)-1+
     *  SSMP(SSMPST(4)-1+I00001)),I00002)-V00123(I00001,I00002)-
     *  V00124(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('S01272')
      RETURN
      END
      SUBROUTINE S01273(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00086,C00094,C00095,C00278,
     *  V00013,V00014,V00015,V00016,V00088,V00089,V00090,V00091,
     *  V00092,V00105,V00106,V00107,V00108,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00007
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00086(SSZ(10),SSZ(1))
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00095(SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      REAL V00013(SSZ(12),SSZ(1))
      REAL V00014(SSZ(12),SSZ(1))
      REAL V00015(SSZ(9),SSZ(10),SSZ(1))
      REAL V00016(SSZ(9),SSZ(10),SSZ(1))
      REAL V00088(SSZ(10))
      REAL V00089(SSZ(1))
      REAL V00090(SSZ(10),SSZ(1))
      REAL V00091(SSZ(10))
      REAL V00092(SSZ(1))
      REAL V00105(SSZ(9))
      REAL V00106(SSZ(10))
      REAL V00107(SSZ(1))
      REAL V00108(SSZ(9),SSZ(10),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 "ENDWDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(9)
      DO 2 I00004=1,SSZ(10)
      RS1=0.0
      DO 4 I00007=1,SSZ(9)
      RS1=RS1-(-C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00094(I00007,I00004,I00002)*V00015(I00007,I00004,I00002)
    4 CONTINUE
      RS2=0.0
      DO 5 I00007=1,SSZ(9)
      RS2=RS2+(-C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00094(I00007,I00004,I00002)*V00105(I00007)
    5 CONTINUE
      RS3=-C00086(I00004,I00002)*V00013(SSMP(SSMPST(10)-1+
     *  I00004),I00002)-1.0*V00014(SSMP(SSMPST(10)-1+I00004),I00002)+
     *  C00095(I00004,I00002)*V00015(I00001,I00004,I00002)+RS1-(-1.0+
     *  C00086(I00004,I00002))*V00088(I00004)-(-1.0+
     *  C00086(I00004,I00002))*V00089(I00002)-(-1.0+
     *  C00086(I00004,I00002))*V00090(I00004,I00002)-(-1.0+
     *  C00086(I00004,I00002))*V00091(I00004)-(-1.0+
     *  C00086(I00004,I00002))*V00092(I00002)+RS2
      RS4=0.0
      DO 6 I00007=1,SSZ(9)
      RS4=RS4+(-C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00094(I00007,I00004,I00002)*V00108(I00007,I00004,I00002)
    6 CONTINUE
      V00016(I00001,I00004,I00002)=-(RS3-(-1.0+C00095(I00004,I00002))*
     *  V00105(I00001)+((-C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00278(I00004,I00002)-(-1.0+C00095(I00004,I00002)))*
     *  V00106(I00004)+((-C00086(I00004,I00002)+C00095(I00004,I00002))*
     *  C00278(I00004,I00002)-(-1.0+C00095(I00004,I00002)))*
     *  V00107(I00002)+RS4-(-1.0+C00095(I00004,I00002))*
     *  V00108(I00001,I00004,I00002))
    2 CONTINUE
    1 CONTINUE
    3 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 "ENDWDEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01273')
      RETURN
      END
      SUBROUTINE S01274(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00094,C00278,
     *  V00015,V00075,V00105,V00106,V00107,V00108,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00002
      INTEGER I00004
      INTEGER I00007
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00094(SSZ(9),SSZ(10),SSZ(1))
      REAL C00278(SSZ(10),SSZ(1))
      REAL V00015(SSZ(9),SSZ(10),SSZ(1))
      REAL V00075(SSZ(10),SSZ(1))
      REAL V00105(SSZ(9))
      REAL V00106(SSZ(10))
      REAL V00107(SSZ(1))
      REAL V00108(SSZ(9),SSZ(10),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 "pva"',
     *  ' using equation "VAPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(10)
      RS1=0.0
      DO 3 I00007=1,SSZ(9)
      RS1=RS1-C00094(I00007,I00004,I00002)*V00015(I00007,I00004,I00002)
    3 CONTINUE
      RS2=0.0
      DO 4 I00007=1,SSZ(9)
      RS2=RS2+C00094(I00007,I00004,I00002)*V00105(I00007)
    4 CONTINUE
      RS3=0.0
      DO 5 I00007=1,SSZ(9)
      RS3=RS3+C00094(I00007,I00004,I00002)*V00108(I00007,I00004,I00002)
    5 CONTINUE
      V00075(I00004,I00002)=-(RS1+RS2+C00278(I00004,I00002)*
     *  V00106(I00004)+C00278(I00004,I00002)*V00107(I00002)+RS3)
    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 "pva"',
     *  ' using equation "VAPRICE"',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,
     *  V00081,V00105,V00106,V00107,V00108,
     *  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 V00081(SSZ(9),SSZ(10),SSZ(1))
      REAL V00105(SSZ(9))
      REAL V00106(SSZ(10))
      REAL V00107(SSZ(1))
      REAL V00108(SSZ(9),SSZ(10),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 "afe"',
     *  ' using equation "AFEWORLD"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(9)
      DO 2 I00004=1,SSZ(10)
      DO 3 I00002=1,SSZ(1)
      V00081(I00001,I00004,I00002)=(V00105(I00001)+V00106(I00004)+
     *  V00107(I00002)+V00108(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 "afe"',
     *  ' using equation "AFEWORLD"',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,
     *  C00056,C00096,
     *  V00005,V00008,V00020,V00078,V00109,V00110,
     *  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
      REAL C00056(SSZ(5))
      REAL C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL V00005(SSZ(12),SSZ(1))
      REAL V00008(SSZ(5),SSZ(1))
      REAL V00020(SSZ(5),SSZ(10),SSZ(1))
      REAL V00078(SSZ(5),SSZ(10),SSZ(1))
      REAL V00109(SSZ(5),SSZ(10),SSZ(1))
      REAL V00110(SSZ(5),SSZ(10),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(10)
      DO 1 I00001=1,SSZ(5)
      V00020(I00001,I00004,I00003)=-(-C00056(I00001)*(1  -
     *  C00096(I00001,I00004,I00003))*V00005(SSMP(SSMPST(10)-1+
     *  SSMP(SSMPST(4)-1+I00001)),I00003)+(C00056(I00001)-
     *  C00056(I00001)*C00096(I00001,I00004,I00003))*
     *  V00008(I00001,I00003)-1.0*V00078(I00001,I00004,I00003)-
     *  C00056(I00001)*(1  -C00096(I00001,I00004,I00003))*
     *  V00109(I00001,I00004,I00003)+(-C00056(I00001)*
     *  C00096(I00001,I00004,I00003)+C00056(I00001))*
     *  V00110(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('S01276')
      RETURN
      END
      SUBROUTINE S01277(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00096,
     *  V00005,V00008,V00077,V00109,V00110,
     *  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 C00096(SSZ(5),SSZ(10),SSZ(1))
      REAL V00005(SSZ(12),SSZ(1))
      REAL V00008(SSZ(5),SSZ(1))
      REAL V00077(SSZ(5),SSZ(10),SSZ(1))
      REAL V00109(SSZ(5),SSZ(10),SSZ(1))
      REAL V00110(SSZ(5),SSZ(10),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 "pf"',
     *  ' using equation "ICOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)
      DO 2 I00004=1,SSZ(10)
      DO 1 I00001=1,SSZ(5)
      V00077(I00001,I00004,I00002)=-(-(1  -
     *  C00096(I00001,I00004,I00002))*V00005(SSMP(SSMPST(10)-1+
     *  SSMP(SSMPST(4)-1+I00001)),I00002)-C00096(I00001,I00004,I00002)*
     *  V00008(I00001,I00002)-(1  -C00096(I00001,I00004,I00002))*
     *  V00109(I00001,I00004,I00002)-C00096(I00001,I00004,I00002)*
     *  V00110(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 "pf"',
     *  ' using equation "ICOMPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01277')
      RETURN
      END
      SUBROUTINE S01278(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00008,V00019,V00110,
     *  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 V00008(SSZ(5),SSZ(1))
      REAL V00019(SSZ(5),SSZ(10),SSZ(1))
      REAL V00110(SSZ(5),SSZ(10),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 "pfm"',
     *  ' using equation "DMNDIPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(5)
      DO 2 I00004=1,SSZ(10)
      DO 3 I00002=1,SSZ(1)
      V00019(I00001,I00004,I00002)=(V00110(I00001,I00004,I00002)+
     *  V00008(I00001,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 "pfm"',
     *  ' using equation "DMNDIPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01278')
      RETURN
      END
      SUBROUTINE S01279(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00005,V00017,V00109,
     *  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 V00005(SSZ(12),SSZ(1))
      REAL V00017(SSZ(5),SSZ(10),SSZ(1))
      REAL V00109(SSZ(5),SSZ(10),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 "pfd"',
     *  ' using equation "DMNDDPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(5)
      DO 2 I00004=1,SSZ(10)
      DO 3 I00002=1,SSZ(1)
      V00017(I00001,I00004,I00002)=(V00109(I00001,I00004,I00002)+
     *  V00005(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001)),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 "pfd"',
     *  ' using equation "DMNDDPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01279')
      RETURN
      END
      SUBROUTINE S01280(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00094,V00098,V00099,V00100,V00101,
     *  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 V00094(SSZ(5),SSZ(10),SSZ(1))
      REAL V00098(SSZ(5))
      REAL V00099(SSZ(10))
      REAL V00100(SSZ(1))
      REAL V00101(SSZ(5),SSZ(10),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(5)
      DO 2 I00004=1,SSZ(10)
      DO 3 I00002=1,SSZ(1)
      V00094(I00001,I00004,I00002)=(V00098(I00001)+V00099(I00004)+
     *  V00100(I00002)+V00101(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('S01280')
      RETURN
      END
      SUBROUTINE S01281(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00086,
     *  V00013,V00014,V00075,V00076,V00088,V00089,V00090,V00091,
     *  V00092,
     *  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 C00086(SSZ(10),SSZ(1))
      REAL V00013(SSZ(12),SSZ(1))
      REAL V00014(SSZ(12),SSZ(1))
      REAL V00075(SSZ(10),SSZ(1))
      REAL V00076(SSZ(10),SSZ(1))
      REAL V00088(SSZ(10))
      REAL V00089(SSZ(1))
      REAL V00090(SSZ(10),SSZ(1))
      REAL V00091(SSZ(10))
      REAL V00092(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 "qva"',
     *  ' using equation "VADEMAND"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00004=1,SSZ(10)
      V00076(I00004,I00002)=-(-C00086(I00004,I00002)*
     *  V00013(SSMP(SSMPST(10)-1+I00004),I00002)-1.0*
     *  V00014(SSMP(SSMPST(10)-1+I00004),I00002)+C00086(I00004,I00002)*
     *  V00075(I00004,I00002)-(-1.0+C00086(I00004,I00002))*
     *  V00088(I00004)-(-1.0+C00086(I00004,I00002))*V00089(I00002)-(-
     *  1.0+C00086(I00004,I00002))*V00090(I00004,I00002)-(-1.0+
     *  C00086(I00004,I00002))*V00091(I00004)-(-1.0+
     *  C00086(I00004,I00002))*V00092(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 "qva"',
     *  ' using equation "VADEMAND"',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,
     *  V00080,V00091,V00092,
     *  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 V00080(SSZ(10),SSZ(1))
      REAL V00091(SSZ(10))
      REAL V00092(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 "ava"',
     *  ' using equation "AVAWORLD"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00004=1,SSZ(10)
      DO 2 I00002=1,SSZ(1)
      V00080(I00004,I00002)=(V00091(I00004)+V00092(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 "ava"',
     *  ' using equation "AVAWORLD"',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,
     *  V00079,V00088,V00089,V00090,
     *  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 V00079(SSZ(10),SSZ(1))
      REAL V00088(SSZ(10))
      REAL V00089(SSZ(1))
      REAL V00090(SSZ(10),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(10)
      DO 2 I00002=1,SSZ(1)
      V00079(I00004,I00002)=(V00088(I00004)+V00089(I00002)+
     *  V00090(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('S01283')
      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''',
     *    'usyfrealoff','usREALFINCOMEOFF',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01259(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00038,V00221,V00227,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'usyfrealon','usREALFINCOMEON',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01260(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00038,V00220,V00226,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'usyfreal','usREALFARMINCOME',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01261(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00038,V00219,V00225,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'c3_ir','c3_irEQ',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01262(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00155,
     *  V00200,V00201,V00205,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'c2_ir','c2_irEQ',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01263(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00151,
     *  V00199,V00201,V00204,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'c1_ir','c1_irEQ',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01264(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00151,C00155,
     *  V00201,V00202,V00203,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pfactreal','REALRETURN',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01265(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00005,V00038,V00163,
     *  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 S01266(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00014,V00171,V00172,
     *  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 S01267(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00114,C00116,C00117,C00348,
     *  V00005,V00028,V00123,V00124,V00130,V00131,V00132,V00133,
     *  V00137,
     *  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 S01268(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00129,V00130,V00131,V00132,V00133,
     *  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 S01269(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00114,
     *  V00129,V00135,V00137,
     *  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 S01270(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00027,V00128,V00129,
     *  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 S01271(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00026,V00028,V00125,V00126,
     *  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 S01272(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00005,V00029,V00123,V00124,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qfe','ENDWDEMAND',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01273(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00086,C00094,C00095,C00278,
     *  V00013,V00014,V00015,V00016,V00088,V00089,V00090,V00091,
     *  V00092,V00105,V00106,V00107,V00108,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pva','VAPRICE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01274(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00094,C00278,
     *  V00015,V00075,V00105,V00106,V00107,V00108,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'afe','AFEWORLD',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01275(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00081,V00105,V00106,V00107,V00108,
     *  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 S01276(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00056,C00096,
     *  V00005,V00008,V00020,V00078,V00109,V00110,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pf','ICOMPRICE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01277(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00096,
     *  V00005,V00008,V00077,V00109,V00110,
     *  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 S01278(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00008,V00019,V00110,
     *  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 S01279(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00005,V00017,V00109,
     *  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 S01280(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00094,V00098,V00099,V00100,V00101,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qva','VADEMAND',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01281(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00086,
     *  V00013,V00014,V00075,V00076,V00088,V00089,V00090,V00091,
     *  V00092,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'ava','AVAWORLD',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01282(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00080,V00091,V00092,
     *  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 S01283(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00079,V00088,V00089,V00090,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00031')
      RETURN
      END
      SUBROUTINE S01284(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00056,
     *  V00008,V00012,V00057,V00058,V00074,
     *  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
      REAL C00056(SSZ(5))
      REAL V00008(SSZ(5),SSZ(1))
      REAL V00012(SSZ(5),SSZ(1))
      REAL V00057(SSZ(5),SSZ(1))
      REAL V00058(SSZ(5),SSZ(1))
      REAL V00074(SSZ(5),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 1 I00001=1,SSZ(5)
      DO 2 I00003=1,SSZ(1)
      V00012(I00001,I00003)=-(C00056(I00001)*V00008(I00001,I00003)-
     *  C00056(I00001)*V00057(I00001,I00003)-1.0*V00058(I00001,I00003)+
     *  C00056(I00001)*V00074(I00001,I00003))
    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 "qpm"',
     *  ' using equation "PHHLDAGRIMP"',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,
     *  V00008,V00011,V00074,
     *  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 V00008(SSZ(5),SSZ(1))
      REAL V00011(SSZ(5),SSZ(1))
      REAL V00074(SSZ(5),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 "ppm"',
     *  ' using equation "PHHIPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(5)
      DO 2 I00002=1,SSZ(1)
      V00011(I00001,I00002)=(V00074(I00001,I00002)+
     *  V00008(I00001,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 "ppm"',
     *  ' using equation "PHHIPRICES"',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,
     *  V00005,V00009,V00072,
     *  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 V00005(SSZ(12),SSZ(1))
      REAL V00009(SSZ(5),SSZ(1))
      REAL V00072(SSZ(5),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 "ppd"',
     *  ' using equation "PHHDPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(5)
      DO 2 I00002=1,SSZ(1)
      V00009(I00001,I00002)=(V00072(I00001,I00002)+
     *  V00005(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001)),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 "ppd"',
     *  ' using equation "PHHDPRICE"',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,
     *  C00084,
     *  V00066,V00067,V00068,V00069,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00009
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00084(SSZ(30))
      REAL V00066(SSZ(30),SSZ(1))
      REAL V00067(SSZ(30),SSZ(1))
      REAL V00068(SSZ(30),SSZ(5),SSZ(1))
      REAL V00069(SSZ(30),SSZ(5),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 "dqpp"',
     *  ' using equation "COMPQUANT"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00009=1,SSZ(30)
      DO 2 I00001=1,SSZ(5)
      DO 3 I00002=1,SSZ(1)
      V00068(I00009,I00001,I00002)=(V00067(I00009,I00002)+
     *  C00084(I00009)*(V00066(I00009,I00002)-
     *  V00069(I00009,I00001,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 "dqpp"',
     *  ' using equation "COMPQUANT"',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,
     *  C00034,C00035,C00056,C00061,
     *  V00005,V00007,V00008,V00032,V00037,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00003
      INTEGER I00016
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8
      LOGICAL ECHO1
      REAL C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL C00056(SSZ(5))
      REAL C00061(SSZ(5),SSZ(1))
      REAL V00005(SSZ(12),SSZ(1))
      REAL V00007(SSZ(5),SSZ(1))
      REAL V00008(SSZ(5),SSZ(1))
      REAL V00032(SSZ(1))
      REAL V00037(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(5)
      RS1=0.0
      DO 3 I00016=1,SSZ(5)
      RS2=-C00034(I00016,I00003)
      RS3=C00035(I00003)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*(1  -C00061(I00016,I00003))*V00005(SSMP(SSMPST(10)-1+
     *  SSMP(SSMPST(4)-1+I00016)),I00003)
    3 CONTINUE
      RS5=0.0
      DO 4 I00016=1,SSZ(5)
      RS6=-C00034(I00016,I00003)
      RS7=C00035(I00003)
      IF(RS7.NE.0.0) THEN
        RS8=RS6/RS7
      ELSE
        RS8=1.0
        IER=2
      END IF
      RS5=RS5+RS8*C00061(I00016,I00003)*V00008(I00016,I00003)
    4 CONTINUE
      V00007(I00001,I00003)=-(-(-1.0+C00056(I00001))*(1  -
     *  C00061(I00001,I00003))*V00005(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-
     *  1+I00001)),I00003)+RS1+(C00056(I00001)-(-1.0+C00056(I00001))*
     *  C00061(I00001,I00003))*V00008(I00001,I00003)+RS5-1.0*
     *  V00032(I00003)-1.0*V00037(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('S01288')
      RETURN
      END
      SUBROUTINE S01289(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00061,
     *  V00005,V00008,V00053,
     *  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
      REAL C00061(SSZ(5),SSZ(1))
      REAL V00005(SSZ(12),SSZ(1))
      REAL V00008(SSZ(5),SSZ(1))
      REAL V00053(SSZ(5),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(5)
      V00053(I00001,I00003)=-(-(1  -C00061(I00001,I00003))*
     *  V00005(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+I00001)),I00003)-
     *  C00061(I00001,I00003)*V00008(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 "pg"',
     *  ' using equation "GCOMPRICE"',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,
     *  V00006,V00008,
     *  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 V00006(SSZ(5),SSZ(1))
      REAL V00008(SSZ(5),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 "pgm"',
     *  ' using equation "GHHIPRICES"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(5)
      DO 2 I00002=1,SSZ(1)
      V00006(I00001,I00002)=V00008(I00001,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 "pgm"',
     *  ' using equation "GHHIPRICES"',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,
     *  V00003,V00005,
     *  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 V00003(SSZ(5),SSZ(1))
      REAL V00005(SSZ(12),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 "pgd"',
     *  ' using equation "GHHDPRICE"',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(5)
      DO 2 I00002=1,SSZ(1)
      V00003(I00001,I00002)=V00005(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+
     *  I00001)),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 "pgd"',
     *  ' using equation "GHHDPRICE"',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,
     *  C00034,C00035,
     *  V00032,V00037,V00053,V00054,
     *  ERRMES)
      USE PSIMMOD1
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER I00001
      INTEGER I00002
      INTEGER I00016
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL V00032(SSZ(1))
      REAL V00037(SSZ(1))
      REAL V00053(SSZ(5),SSZ(1))
      REAL V00054(SSZ(5),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(5)
      DO 2 I00002=1,SSZ(1)
      RS1=0.0
      DO 3 I00016=1,SSZ(5)
      RS2=-C00034(I00016,I00002)
      RS3=C00035(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*V00053(I00016,I00002)
    3 CONTINUE
      V00054(I00001,I00002)=-(-1.0*V00032(I00002)-1.0*V00037(I00002)+
     *  1.0*V00053(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('S01292')
      RETURN
      END
      SUBROUTINE S01293(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00034,C00035,
     *  V00035,V00053,
     *  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 C00034(SSZ(5),SSZ(1))
      REAL C00035(SSZ(1))
      REAL V00035(SSZ(1))
      REAL V00053(SSZ(5),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(5)
      RS2=C00034(I00001,I00002)
      RS3=C00035(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IER=2
      END IF
      RS1=RS1+RS4*V00053(I00001,I00002)
    2 CONTINUE
      V00035(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('S01293')
      RETURN
      END
      SUBROUTINE M00032(
     *  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''',
     *    'qpm','PHHLDAGRIMP',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01284(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00056,
     *  V00008,V00012,V00057,V00058,V00074,
     *  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 S01285(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00008,V00011,V00074,
     *  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 S01286(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00005,V00009,V00072,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'dqpp','COMPQUANT',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01287(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00084,
     *  V00066,V00067,V00068,V00069,
     *  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 S01288(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00034,C00035,C00056,C00061,
     *  V00005,V00007,V00008,V00032,V00037,
     *  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 S01289(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00061,
     *  V00005,V00008,V00053,
     *  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 S01290(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00006,V00008,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       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 S01291(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  V00003,V00005,
     *  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 S01292(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00034,C00035,
     *  V00032,V00037,V00053,V00054,
     *  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 S01293(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00034,C00035,
     *  V00035,V00053,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00032')
      RETURN
      END
      SUBROUTINE S01294(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('S01294')
      RETURN
      END
      SUBROUTINE S01296(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,
     *  V00001,V00002,
     *  U00008,
     *  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 C00008(SSZ(1))
      REAL V00001(SSZ(1))
      REAL V00002(SSZ(1))
      REAL U00008(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)
      U00008(I00002)=C00008(I00002)*(V00001(I00002)/100.0 +
     *  V00002(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00008),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(8),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00008,U00008,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('S01296')
      RETURN
      END
      SUBROUTINE S01297(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00009,
     *  V00003,V00004,
     *  U00009,
     *  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 C00009(SSZ(5),SSZ(1))
      REAL V00003(SSZ(5),SSZ(1))
      REAL V00004(SSZ(5),SSZ(1))
      REAL U00009(SSZ(5),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(5)
      U00009(I00001,I00002)=C00009(I00001,I00002)*
     *  (V00003(I00001,I00002)/100.0 +V00004(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00009),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(9),KSTEP,NSTEP,METHOD,
     *    SSZ(5),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(5),SSZ(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 "VDGA"',
     *  ' ',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,
     *  C00010,
     *  V00004,V00005,
     *  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(5),SSZ(1))
      REAL V00004(SSZ(5),SSZ(1))
      REAL V00005(SSZ(12),SSZ(1))
      REAL U00010(SSZ(5),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(5)
      U00010(I00001,I00002)=C00010(I00001,I00002)*
     *  (V00005(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+
     *  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(5),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(5),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 "VDGM"',
     *  ' ',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,
     *  C00011,
     *  V00006,V00007,
     *  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(5),SSZ(1))
      REAL V00006(SSZ(5),SSZ(1))
      REAL V00007(SSZ(5),SSZ(1))
      REAL U00011(SSZ(5),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(5)
      U00011(I00001,I00002)=C00011(I00001,I00002)*
     *  (V00006(I00001,I00002)/100.0 +V00007(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(5),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(5),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 "VIGA"',
     *  ' ',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,
     *  C00012,
     *  V00007,V00008,
     *  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(5),SSZ(1))
      REAL V00007(SSZ(5),SSZ(1))
      REAL V00008(SSZ(5),SSZ(1))
      REAL U00012(SSZ(5),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(5)
      U00012(I00001,I00002)=C00012(I00001,I00002)*
     *  (V00008(I00001,I00002)/100.0 +V00007(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(5),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(5),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 "VIGM"',
     *  ' ',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,
     *  C00013,
     *  V00009,V00010,
     *  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(5),SSZ(1))
      REAL V00009(SSZ(5),SSZ(1))
      REAL V00010(SSZ(5),SSZ(1))
      REAL U00013(SSZ(5),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(5)
      U00013(I00001,I00002)=C00013(I00001,I00002)*
     *  (V00009(I00001,I00002)/100.0 +V00010(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(5),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(5),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 "VDPA"',
     *  ' ',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,
     *  C00014,
     *  V00005,V00010,
     *  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(5),SSZ(1))
      REAL V00005(SSZ(12),SSZ(1))
      REAL V00010(SSZ(5),SSZ(1))
      REAL U00014(SSZ(5),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(5)
      U00014(I00001,I00002)=C00014(I00001,I00002)*
     *  (V00005(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+
     *  I00001)),I00002)/100.0 +V00010(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(5),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(5),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 "VDPM"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01302')
      RETURN
      END
      SUBROUTINE S01303(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00015,
     *  V00011,V00012,
     *  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(5),SSZ(1))
      REAL V00011(SSZ(5),SSZ(1))
      REAL V00012(SSZ(5),SSZ(1))
      REAL U00015(SSZ(5),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(5)
      U00015(I00001,I00002)=C00015(I00001,I00002)*
     *  (V00011(I00001,I00002)/100.0 +V00012(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(5),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(5),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 "VIPA"',
     *  ' ',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,
     *  C00016,
     *  V00008,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(5),SSZ(1))
      REAL V00008(SSZ(5),SSZ(1))
      REAL V00012(SSZ(5),SSZ(1))
      REAL U00016(SSZ(5),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(5)
      U00016(I00001,I00002)=C00016(I00001,I00002)*
     *  (V00008(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(5),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(5),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 "VIPM"',
     *  ' ',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,
     *  C00017,
     *  V00013,V00014,
     *  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(9),SSZ(1))
      REAL V00013(SSZ(12),SSZ(1))
      REAL V00014(SSZ(12),SSZ(1))
      REAL U00017(SSZ(9),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(9)
      U00017(I00001,I00002)=C00017(I00001,I00002)*
     *  (V00013(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-1+
     *  I00001)),I00002)/100.0 +V00014(SSMP(SSMPST(8)-1+SSMP(SSMPST(6)-
     *  1+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(9),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(9),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 "EVOA"',
     *  ' ',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,
     *  C00018,
     *  V00015,V00016,
     *  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 I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00018(SSZ(9),SSZ(10),SSZ(1))
      REAL V00015(SSZ(9),SSZ(10),SSZ(1))
      REAL V00016(SSZ(9),SSZ(10),SSZ(1))
      REAL U00018(SSZ(9),SSZ(10),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(10)
      DO 1 I00001=1,SSZ(9)
      U00018(I00001,I00004,I00002)=C00018(I00001,I00004,I00002)*
     *  (V00015(I00001,I00004,I00002)/100.0 +
     *  V00016(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00018),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(18),KSTEP,NSTEP,METHOD,
     *    SSZ(9),SSZ(10),SSZ(1),1,
     *    1,1,1,
     *    SSZ(9),SSZ(10),SSZ(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 "EVFA"',
     *  ' ',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,
     *  C00019,
     *  V00017,V00018,
     *  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 I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00019(SSZ(5),SSZ(10),SSZ(1))
      REAL V00017(SSZ(5),SSZ(10),SSZ(1))
      REAL V00018(SSZ(5),SSZ(10),SSZ(1))
      REAL U00019(SSZ(5),SSZ(10),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(10)
      DO 1 I00001=1,SSZ(5)
      U00019(I00001,I00004,I00002)=C00019(I00001,I00004,I00002)*
     *  (V00017(I00001,I00004,I00002)/100.0 +
     *  V00018(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00019),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(19),KSTEP,NSTEP,METHOD,
     *    SSZ(5),SSZ(10),SSZ(1),1,
     *    1,1,1,
     *    SSZ(5),SSZ(10),SSZ(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 "VDFA"',
     *  ' ',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,
     *  C00020,
     *  V00019,V00020,
     *  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 I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00020(SSZ(5),SSZ(10),SSZ(1))
      REAL V00019(SSZ(5),SSZ(10),SSZ(1))
      REAL V00020(SSZ(5),SSZ(10),SSZ(1))
      REAL U00020(SSZ(5),SSZ(10),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(10)
      DO 1 I00001=1,SSZ(5)
      U00020(I00001,I00004,I00002)=C00020(I00001,I00004,I00002)*
     *  (V00019(I00001,I00004,I00002)/100.0 +
     *  V00020(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00020),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(20),KSTEP,NSTEP,METHOD,
     *    SSZ(5),SSZ(10),SSZ(1),1,
     *    1,1,1,
     *    SSZ(5),SSZ(10),SSZ(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 "VIFA"',
     *  ' ',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,
     *  C00021,
     *  V00016,V00021,V00022,V00023,
     *  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 I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00021(SSZ(9),SSZ(10),SSZ(1))
      REAL V00016(SSZ(9),SSZ(10),SSZ(1))
      REAL V00021(SSZ(28),SSZ(1))
      REAL V00022(SSZ(28),SSZ(1))
      REAL V00023(SSZ(27),SSZ(10),SSZ(1))
      REAL U00021(SSZ(9),SSZ(10),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(9),SSZ(10),SSZ(1),1,
     *  1,1,1,
     *  U00021,0.0,1,1,1,1,1,1,1,
     *  SSZ(9),SSZ(10),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(15)
      DO 1 I00001=1,SSZ(28)
      U00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-
     *  1+I00004)),I00002)=C00021(SSMP(SSMPST(27)-1+
     *  I00001),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+I00004)),I00002)*
     *  (V00021(I00001,I00002)/100.0 +V00016(SSMP(SSMPST(27)-1+
     *  I00001),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00004)),I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      DO 6 I00002=1,SSZ(1)
      DO 5 I00004=1,SSZ(16)
      DO 4 I00001=1,SSZ(28)
      U00021(SSMP(SSMPST(27)-1+I00001),SSMP(SSMPST(13)-1+
     *  I00004),I00002)=C00021(SSMP(SSMPST(27)-1+
     *  I00001),SSMP(SSMPST(13)-1+I00004),I00002)*
     *  (V00022(I00001,I00002)/100.0 +V00016(SSMP(SSMPST(27)-1+
     *  I00001),SSMP(SSMPST(13)-1+I00004),I00002)/100.0 )
    4 CONTINUE
    5 CONTINUE
    6 CONTINUE
      DO 9 I00002=1,SSZ(1)
      DO 8 I00004=1,SSZ(10)
      DO 7 I00001=1,SSZ(27)
      U00021(SSMP(SSMPST(26)-1+I00001),I00004,I00002)=
     *  C00021(SSMP(SSMPST(26)-1+I00001),I00004,I00002)*
     *  (V00023(I00001,I00004,I00002)/100.0 +V00016(SSMP(SSMPST(26)-1+
     *  I00001),I00004,I00002)/100.0 )
    7 CONTINUE
    8 CONTINUE
    9 CONTINUE
      CALL GPARW(SIZE(C00021),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(21),KSTEP,NSTEP,METHOD,
     *    SSZ(9),SSZ(10),SSZ(1),1,
     *    1,1,1,
     *    SSZ(9),SSZ(10),SSZ(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 "VFM"',
     *  ' ',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,
     *  C00022,
     *  V00008,V00020,
     *  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 I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00022(SSZ(5),SSZ(10),SSZ(1))
      REAL V00008(SSZ(5),SSZ(1))
      REAL V00020(SSZ(5),SSZ(10),SSZ(1))
      REAL U00022(SSZ(5),SSZ(10),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(10)
      DO 1 I00001=1,SSZ(5)
      U00022(I00001,I00004,I00002)=C00022(I00001,I00004,I00002)*
     *  (V00008(I00001,I00002)/100.0 +
     *  V00020(I00001,I00004,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00022),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(22),KSTEP,NSTEP,METHOD,
     *    SSZ(5),SSZ(10),SSZ(1),1,
     *    1,1,1,
     *    SSZ(5),SSZ(10),SSZ(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 "VIFM"',
     *  ' ',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,
     *  C00023,
     *  V00005,V00018,
     *  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(5),SSZ(10),SSZ(1))
      REAL V00005(SSZ(12),SSZ(1))
      REAL V00018(SSZ(5),SSZ(10),SSZ(1))
      REAL U00023(SSZ(5),SSZ(10),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(10)
      DO 1 I00001=1,SSZ(5)
      U00023(I00001,I00004,I00002)=C00023(I00001,I00004,I00002)*
     *  (V00005(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+
     *  I00001)),I00002)/100.0 +V00018(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(5),SSZ(10),SSZ(1),1,
     *    1,1,1,
     *    SSZ(5),SSZ(10),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 "VDFM"',
     *  ' ',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,
     *  C00024,
     *  V00024,V00025,
     *  U00024,
     *  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 C00024(SSZ(1))
      REAL V00024(SSZ(1))
      REAL V00025(SSZ(1))
      REAL U00024(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)
      U00024(I00002)=C00024(I00002)*(V00024(I00002)/100.0 +
     *  V00025(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00024),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(24),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,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 "VDEP"',
     *  ' ',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,
     *  C00025,
     *  V00026,V00027,
     *  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 I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00025(SSZ(5),SSZ(1),SSZ(1))
      REAL V00026(SSZ(5),SSZ(1),SSZ(1))
      REAL V00027(SSZ(5),SSZ(1),SSZ(1))
      REAL U00025(SSZ(5),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(5)
      U00025(I00001,I00002,I00003)=C00025(I00001,I00002,I00003)*
     *  (V00026(I00001,I00002,I00003)/100.0 +
     *  V00027(I00001,I00002,I00003)/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(5),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(5),SSZ(1),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 "VIMS"',
     *  ' ',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,
     *  C00026,
     *  V00027,V00028,
     *  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 I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00026(SSZ(5),SSZ(1),SSZ(1))
      REAL V00027(SSZ(5),SSZ(1),SSZ(1))
      REAL V00028(SSZ(5),SSZ(1),SSZ(1))
      REAL U00026(SSZ(5),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(5)
      U00026(I00001,I00002,I00003)=C00026(I00001,I00002,I00003)*
     *  (V00028(I00001,I00002,I00003)/100.0 +
     *  V00027(I00001,I00002,I00003)/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(5),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(5),SSZ(1),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 "VIWS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01314')
      RETURN
      END
      SUBROUTINE S01315(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00027,
     *  V00027,V00029,
     *  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 I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00027(SSZ(5),SSZ(1),SSZ(1))
      REAL V00027(SSZ(5),SSZ(1),SSZ(1))
      REAL V00029(SSZ(5),SSZ(1),SSZ(1))
      REAL U00027(SSZ(5),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(5)
      U00027(I00001,I00002,I00003)=C00027(I00001,I00002,I00003)*
     *  (V00029(I00001,I00002,I00003)/100.0 +
     *  V00027(I00001,I00002,I00003)/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(5),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(5),SSZ(1),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 "VXWD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01315')
      RETURN
      END
      SUBROUTINE S01316(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00028,
     *  V00005,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 I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00028(SSZ(5),SSZ(1),SSZ(1))
      REAL V00005(SSZ(12),SSZ(1))
      REAL V00027(SSZ(5),SSZ(1),SSZ(1))
      REAL U00028(SSZ(5),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(5)
      U00028(I00001,I00002,I00003)=C00028(I00001,I00002,I00003)*
     *  (V00005(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+
     *  I00001)),I00002)/100.0 +V00027(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00028),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(28),KSTEP,NSTEP,METHOD,
     *    SSZ(5),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(5),SSZ(1),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 "VXMD"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01316')
      RETURN
      END
      SUBROUTINE S01317(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00029,
     *  V00005,V00030,
     *  U00029,
     *  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 C00029(SSZ(6),SSZ(1))
      REAL V00005(SSZ(12),SSZ(1))
      REAL V00030(SSZ(6),SSZ(1))
      REAL U00029(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 "VST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(6)
      U00029(I00005,I00002)=C00029(I00005,I00002)*
     *  (V00005(SSMP(SSMPST(10)-1+SSMP(SSMPST(4)-1+SSMP(SSMPST(2)-1+
     *  I00005))),I00002)/100.0 +V00030(I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00029),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(29),KSTEP,NSTEP,METHOD,
     *    SSZ(6),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(6),SSZ(1),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 "VST"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01317')
      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.
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VERNUM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01294(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
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'SAVE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01296(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00008,
     *  V00001,V00002,
     *  U00008,
     *  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 S01297(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00009,
     *  V00003,V00004,
     *  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
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00009),U00009,
     *  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 S01298(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00010,
     *  V00004,V00005,
     *  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''',
     *    'VIGA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01299(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00011,
     *  V00006,V00007,
     *  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''',
     *    'VIGM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01300(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00012,
     *  V00007,V00008,
     *  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''',
     *    'VDPA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01301(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00013,
     *  V00009,V00010,
     *  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''',
     *    'VDPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01302(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00014,
     *  V00005,V00010,
     *  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''',
     *    'VIPA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01303(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00015,
     *  V00011,V00012,
     *  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''',
     *    'VIPM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01304(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00016,
     *  V00008,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''',
     *    'EVOA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01305(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00017,
     *  V00013,V00014,
     *  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''',
     *    'EVFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01306(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00018,
     *  V00015,V00016,
     *  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''',
     *    'VDFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01307(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00019,
     *  V00017,V00018,
     *  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''',
     *    'VIFA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01308(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00020,
     *  V00019,V00020,
     *  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''',
     *    '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
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01309(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00021,
     *  V00016,V00021,V00022,V00023,
     *  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''',
     *    'VIFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01310(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00022,
     *  V00008,V00020,
     *  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''',
     *    'VDFM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01311(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00023,
     *  V00005,V00018,
     *  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''',
     *    'VDEP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01312(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00024,
     *  V00024,V00025,
     *  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''',
     *    'VIMS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01313(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00025,
     *  V00026,V00027,
     *  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''',
     *    'VIWS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01314(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00026,
     *  V00027,V00028,
     *  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''',
     *    'VXWD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01315(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00027,
     *  V00027,V00029,
     *  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''',
     *    'VXMD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01316(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00028,
     *  V00005,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''',
     *    'VST',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01317(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00029,
     *  V00005,V00030,
     *  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
      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
      RETURN
15000 CALL PERET('M00033')
      RETURN
      END
      SUBROUTINE S01325(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00066,
     *  V00062,
     *  U00066,
     *  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 C00066(SSZ(1))
      REAL V00062(SSZ(1))
      REAL U00066(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 "aUCONS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(1)
      U00066(I00001)=C00066(I00001)*(V00062(I00001)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00066),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(66),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00066,U00066,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 "aUCONS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01325')
      RETURN
      END
      SUBROUTINE S01326(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00065,
     *  V00060,
     *  U00065,
     *  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 C00065(SSZ(30),SSZ(1))
      REAL V00060(SSZ(30),SSZ(1))
      REAL U00065(SSZ(30),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 "aQP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(30)
      U00065(I00001,I00002)=C00065(I00001,I00002)*
     *  (V00060(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00065),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(65),KSTEP,NSTEP,METHOD,
     *    SSZ(30),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(30),SSZ(1),1,1,
     *    1,1,1,
     *    C00065,U00065,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 "aQP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01326')
      RETURN
      END
      SUBROUTINE S01327(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00064,
     *  V00059,
     *  U00064,
     *  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 C00064(SSZ(30),SSZ(1))
      REAL V00059(SSZ(30),SSZ(1))
      REAL U00064(SSZ(30),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 "aPP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(30)
      U00064(I00001,I00002)=C00064(I00001,I00002)*
     *  (V00059(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00064),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(64),KSTEP,NSTEP,METHOD,
     *    SSZ(30),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(30),SSZ(1),1,1,
     *    1,1,1,
     *    C00064,U00064,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 "aPP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01327')
      RETURN
      END
      SUBROUTINE S01328(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00071,
     *  V00063,
     *  U00071,
     *  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 C00071(SSZ(30),SSZ(1))
      REAL V00063(SSZ(30),SSZ(1))
      REAL U00071(SSZ(30),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 "aPHI"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(30)
      U00071(I00001,I00002)=C00071(I00001,I00002)*
     *  (V00063(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00071),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(71),KSTEP,NSTEP,METHOD,
     *    SSZ(30),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(30),SSZ(1),1,1,
     *    1,1,1,
     *    C00071,U00071,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 "aPHI"',
     *  ' ',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,
     *  C00072,
     *  V00064,
     *  U00072,
     *  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 C00072(SSZ(1))
      REAL V00064(SSZ(1))
      REAL U00072(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 "aEPSIN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(1)
      U00072(I00001)=C00072(I00001)*(V00064(I00001)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00072),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(72),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00072,U00072,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 "aEPSIN"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01329')
      RETURN
      END
      SUBROUTINE S01330(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00079,
     *  V00065,
     *  U00079,
     *  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 C00079(SSZ(1))
      REAL V00065(SSZ(1))
      REAL U00079(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 "aEXPUCONS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(1)
      U00079(I00001)=C00079(I00001)*(V00065(I00001)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00079),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(79),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00079,U00079,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 "aEXPUCONS"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01330')
      RETURN
      END
      SUBROUTINE S01332(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00081,
     *  V00068,V00069,
     *  U00081,
     *  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 I00009
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00081(SSZ(30),SSZ(5),SSZ(1))
      REAL V00068(SSZ(30),SSZ(5),SSZ(1))
      REAL V00069(SSZ(30),SSZ(5),SSZ(1))
      REAL U00081(SSZ(30),SSZ(5),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 "VPASG"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(5)
      DO 3 I00009=1,SSZ(30)
      U00081(I00009,I00001,I00002)=C00081(I00009,I00001,I00002)*
     *  (V00068(I00009,I00001,I00002)/100.0 +
     *  V00069(I00009,I00001,I00002)/100.0 )
    3 CONTINUE
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00081),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(81),KSTEP,NSTEP,METHOD,
     *    SSZ(30),SSZ(5),SSZ(1),1,
     *    1,1,1,
     *    SSZ(30),SSZ(5),SSZ(1),1,
     *    1,1,1,
     *    C00081,U00081,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 "VPASG"',
     *  ' ',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,
     *  C00082,
     *  V00066,V00067,
     *  U00082,
     *  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 C00082(SSZ(30),SSZ(1))
      REAL V00066(SSZ(30),SSZ(1))
      REAL V00067(SSZ(30),SSZ(1))
      REAL U00082(SSZ(30),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 "VPAP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(30)
      U00082(I00005,I00002)=C00082(I00005,I00002)*
     *  (V00067(I00005,I00002)/100.0 +V00066(I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00082),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(82),KSTEP,NSTEP,METHOD,
     *    SSZ(30),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(30),SSZ(1),1,1,
     *    1,1,1,
     *    C00082,U00082,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 "VPAP"',
     *  ' ',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,
     *  C00083,
     *  V00059,V00061,
     *  U00083,
     *  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 C00083(SSZ(30),SSZ(1))
      REAL V00059(SSZ(30),SSZ(1))
      REAL V00061(SSZ(30),SSZ(1))
      REAL U00083(SSZ(30),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 "VPAC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00005=1,SSZ(30)
      U00083(I00005,I00002)=C00083(I00005,I00002)*
     *  (V00061(I00005,I00002)/100.0 +V00059(I00005,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00083),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(83),KSTEP,NSTEP,METHOD,
     *    SSZ(30),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(30),SSZ(1),1,1,
     *    1,1,1,
     *    C00083,U00083,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 "VPAC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01334')
      RETURN
      END
      SUBROUTINE S01340(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00098,
     *  V00024,V00025,
     *  U00098,
     *  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 C00098(SSZ(1))
      REAL V00024(SSZ(1))
      REAL V00025(SSZ(1))
      REAL U00098(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)
      U00098(I00002)=C00098(I00002)*(V00025(I00002)/100.0 +
     *  V00024(I00002)/100.0 )
    1 CONTINUE
      CALL GPARW(SIZE(C00098),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(98),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00098,U00098,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('S01340')
      RETURN
      END
      SUBROUTINE S01344(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00105,
     *  V00128,V00137,
     *  U00105,
     *  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 C00105(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL V00128(SSZ(6),SSZ(5),SSZ(1),SSZ(1))
      REAL V00137(SSZ(6))
      REAL U00105(SSZ(6),SSZ(5),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(5)
      DO 1 I00005=1,SSZ(6)
      U00105(I00005,I00001,I00002,I00003)=
     *  C00105(I00005,I00001,I00002,I00003)*(V00137(I00005)/100.0 +
     *  V00128(I00005,I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00105),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(105),KSTEP,NSTEP,METHOD,
     *    SSZ(6),SSZ(5),SSZ(1),SSZ(1),
     *    1,1,1,
     *    SSZ(6),SSZ(5),SSZ(1),SSZ(1),
     *    1,1,1,
     *    C00105,U00105,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('S01344')
      RETURN
      END
      SUBROUTINE S01349(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00168,
     *  V00022,V00154,
     *  U00168,
     *  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 C00168(SSZ(28),SSZ(1))
      REAL V00022(SSZ(28),SSZ(1))
      REAL V00154(SSZ(28),SSZ(1))
      REAL U00168(SSZ(28),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 "NFVOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)
      DO 1 I00001=1,SSZ(28)
      U00168(I00001,I00002)=C00168(I00001,I00002)*
     *  (V00022(I00001,I00002)/100.0 +V00154(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00168),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(168),KSTEP,NSTEP,METHOD,
     *    SSZ(28),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(28),SSZ(1),1,1,
     *    1,1,1,
     *    C00168,U00168,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 "NFVOA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01349')
      RETURN
      END
      SUBROUTINE S01357(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00192,
     *  V00021,V00152,
     *  U00192,
     *  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 I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00192(SSZ(9),SSZ(4),SSZ(3),SSZ(2))
      REAL V00021(SSZ(28),SSZ(1))
      REAL V00152(SSZ(28),SSZ(1))
      REAL U00192(SSZ(9),SSZ(4),SSZ(3),SSZ(2))
      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 "FFINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPCVAR(
     *  SSZ(9),SSZ(4),SSZ(3),SSZ(2),
     *  1,1,1,
     *  U00192,0.0,1,1,1,1,1,1,1,
     *  SSZ(9),SSZ(4),SSZ(3),SSZ(2),
     *  1,1,1,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00002=1,SSZ(2)
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(28)
      U00192(SSMP(SSMPST(27)-1+I00011),I00001,I00004,I00002)=
     *  C00192(SSMP(SSMPST(27)-1+I00011),I00001,I00004,I00002)*
     *  (V00021(I00011,SSMP(SSMPST(1)-1+I00002))/100.0 +
     *  V00152(I00011,SSMP(SSMPST(1)-1+I00002))/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00192),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(192),KSTEP,NSTEP,METHOD,
     *    SSZ(9),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    SSZ(9),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    C00192,U00192,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 "FFINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01357')
      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.
      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''',
     *    'aUCONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01325(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00066,
     *  V00062,
     *  U00066,
     *  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''',
     *    'aQP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01326(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00065,
     *  V00060,
     *  U00065,
     *  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''',
     *    'aPP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01327(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00064,
     *  V00059,
     *  U00064,
     *  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''',
     *    'aPHI',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01328(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00071,
     *  V00063,
     *  U00071,
     *  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''',
     *    'aEPSIN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01329(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00072,
     *  V00064,
     *  U00072,
     *  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''',
     *    'aEXPUCONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01330(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00079,
     *  V00065,
     *  U00079,
     *  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
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VPASG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01332(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00081,
     *  V00068,V00069,
     *  U00081,
     *  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''',
     *    'VPAP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01333(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00082,
     *  V00066,V00067,
     *  U00082,
     *  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''',
     *    'VPAC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01334(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00083,
     *  V00059,V00061,
     *  U00083,
     *  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
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VKB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01340(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00098,
     *  V00024,V00025,
     *  U00098,
     *  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(U00098),U00098,
     *  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 S01344(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00105,
     *  V00128,V00137,
     *  U00105,
     *  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(U00105),U00105,
     *  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
      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''',
     *    'NFVOA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01349(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00168,
     *  V00022,V00154,
     *  U00168,
     *  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',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',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',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',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',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',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',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''',
     *    'FFINC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01357(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00192,
     *  V00021,V00152,
     *  U00192,
     *  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 S01363(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00199,
     *  V00016,V00023,
     *  U00199,
     *  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 I00010
      INTEGER I00012
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      REAL V00016(SSZ(9),SSZ(10),SSZ(1))
      REAL V00023(SSZ(27),SSZ(10),SSZ(1))
      REAL U00199(SSZ(13),SSZ(4),SSZ(3),SSZ(15),SSZ(2))
      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 "FLINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 5 I00002=1,SSZ(2)
      DO 4 I00012=1,SSZ(15)
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00010=1,SSZ(13)
      U00199(I00010,I00001,I00004,I00012,I00002)=
     *  C00199(I00010,I00001,I00004,I00012,I00002)*
     *  (V00023(SSMP(SSMPST(28)-1+I00010),SSMP(SSMPST(4)-1+
     *  SSMP(SSMPST(12)-1+I00012)),SSMP(SSMPST(1)-1+I00002))/100.0 +
     *  V00016(SSMP(SSMPST(26)-1+SSMP(SSMPST(28)-1+
     *  I00010)),SSMP(SSMPST(4)-1+SSMP(SSMPST(12)-1+
     *  I00012)),SSMP(SSMPST(1)-1+I00002))/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
    5 CONTINUE
      CALL GPARW(SIZE(C00199),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(199),KSTEP,NSTEP,METHOD,
     *    SSZ(13),SSZ(4),SSZ(3),SSZ(15),
     *    SSZ(2),1,1,
     *    SSZ(13),SSZ(4),SSZ(3),SSZ(15),
     *    SSZ(2),1,1,
     *    C00199,U00199,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 "FLINC"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01363')
      RETURN
      END
      SUBROUTINE S01370(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00209,
     *  V00022,V00154,
     *  U00209,
     *  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 I00011
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00209(SSZ(28),SSZ(4),SSZ(3),SSZ(2))
      REAL V00022(SSZ(28),SSZ(1))
      REAL V00154(SSZ(28),SSZ(1))
      REAL U00209(SSZ(28),SSZ(4),SSZ(3),SSZ(2))
      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 "OFFInc"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00002=1,SSZ(2)
      DO 3 I00004=1,SSZ(3)
      DO 2 I00001=1,SSZ(4)
      DO 1 I00011=1,SSZ(28)
      U00209(I00011,I00001,I00004,I00002)=
     *  C00209(I00011,I00001,I00004,I00002)*
     *  (V00022(I00011,SSMP(SSMPST(1)-1+I00002))/100.0 +
     *  V00154(I00011,SSMP(SSMPST(1)-1+I00002))/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00209),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(209),KSTEP,NSTEP,METHOD,
     *    SSZ(28),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    SSZ(28),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    C00209,U00209,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 "OFFInc"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01370')
      RETURN
      END
      SUBROUTINE S01371(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00223,
     *  V00228,
     *  U00223,
     *  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 C00223(SSZ(4),SSZ(3),SSZ(2))
      REAL V00228(SSZ(4),SSZ(3),SSZ(2))
      REAL U00223(SSZ(4),SSZ(3),SSZ(2))
      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 "aUCONSUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(2)
      DO 2 I00002=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      U00223(I00001,I00002,I00003)=C00223(I00001,I00002,I00003)*
     *  (V00228(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00223),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(223),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(3),SSZ(2),1,
     *    1,1,1,
     *    SSZ(4),SSZ(3),SSZ(2),1,
     *    1,1,1,
     *    C00223,U00223,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 "aUCONSUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01371')
      RETURN
      END
      SUBROUTINE S01372(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00224,
     *  V00229,
     *  U00224,
     *  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 I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00224(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL V00229(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL U00224(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      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 "aQUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00004=1,SSZ(2)
      DO 3 I00003=1,SSZ(3)
      DO 2 I00002=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      U00224(I00001,I00002,I00003,I00004)=
     *  C00224(I00001,I00002,I00003,I00004)*
     *  (V00229(I00001,I00002,I00003,I00004)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00224),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(224),KSTEP,NSTEP,METHOD,
     *    SSZ(30),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    SSZ(30),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    C00224,U00224,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 "aQUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01372')
      RETURN
      END
      SUBROUTINE S01373(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00225,
     *  V00230,
     *  U00225,
     *  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 I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00225(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL V00230(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL U00225(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      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 "aPHIUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00004=1,SSZ(2)
      DO 3 I00003=1,SSZ(3)
      DO 2 I00002=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      U00225(I00001,I00002,I00003,I00004)=
     *  C00225(I00001,I00002,I00003,I00004)*
     *  (V00230(I00001,I00002,I00003,I00004)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00225),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(225),KSTEP,NSTEP,METHOD,
     *    SSZ(30),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    SSZ(30),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    C00225,U00225,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 "aPHIUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01373')
      RETURN
      END
      SUBROUTINE S01374(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00226,
     *  V00231,
     *  U00226,
     *  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 C00226(SSZ(4),SSZ(3),SSZ(2))
      REAL V00231(SSZ(4),SSZ(3),SSZ(2))
      REAL U00226(SSZ(4),SSZ(3),SSZ(2))
      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 "aEPSINUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(2)
      DO 2 I00002=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      U00226(I00001,I00002,I00003)=C00226(I00001,I00002,I00003)*
     *  (V00231(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00226),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(226),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(3),SSZ(2),1,
     *    1,1,1,
     *    SSZ(4),SSZ(3),SSZ(2),1,
     *    1,1,1,
     *    C00226,U00226,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 "aEPSINUSA"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01374')
      RETURN
      END
      SUBROUTINE S01376(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00234,
     *  V00232,
     *  U00234,
     *  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 I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00234(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL V00232(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL U00234(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      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 "aQUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00004=1,SSZ(2)
      DO 3 I00003=1,SSZ(3)
      DO 2 I00002=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      U00234(I00001,I00002,I00003,I00004)=
     *  C00234(I00001,I00002,I00003,I00004)*
     *  (V00232(I00001,I00002,I00003,I00004)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00234),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(234),KSTEP,NSTEP,METHOD,
     *    SSZ(30),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    SSZ(30),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    C00234,U00234,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 "aQUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01376')
      RETURN
      END
      SUBROUTINE S01377(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00235,
     *  V00233,
     *  U00235,
     *  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 I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK,TGSSP
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00235(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL V00233(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      REAL U00235(SSZ(30),SSZ(4),SSZ(3),SSZ(2))
      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 "aPHIUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00004=1,SSZ(2)
      DO 3 I00003=1,SSZ(3)
      DO 2 I00002=1,SSZ(4)
      DO 1 I00001=1,SSZ(30)
      U00235(I00001,I00002,I00003,I00004)=
     *  C00235(I00001,I00002,I00003,I00004)*
     *  (V00233(I00001,I00002,I00003,I00004)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
    4 CONTINUE
      CALL GPARW(SIZE(C00235),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(235),KSTEP,NSTEP,METHOD,
     *    SSZ(30),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    SSZ(30),SSZ(4),SSZ(3),SSZ(2),
     *    1,1,1,
     *    C00235,U00235,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 "aPHIUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01377')
      RETURN
      END
      SUBROUTINE S01378(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00236,
     *  V00234,
     *  U00236,
     *  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 C00236(SSZ(4),SSZ(3),SSZ(2))
      REAL V00234(SSZ(4),SSZ(3),SSZ(2))
      REAL U00236(SSZ(4),SSZ(3),SSZ(2))
      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 "aEPSINUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(2)
      DO 2 I00002=1,SSZ(3)
      DO 1 I00001=1,SSZ(4)
      U00236(I00001,I00002,I00003)=C00236(I00001,I00002,I00003)*
     *  (V00234(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00236),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(236),KSTEP,NSTEP,METHOD,
     *    SSZ(4),SSZ(3),SSZ(2),1,
     *    1,1,1,
     *    SSZ(4),SSZ(3),SSZ(2),1,
     *    1,1,1,
     *    C00236,U00236,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 "aEPSINUSAEV"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01378')
      RETURN
      END
      SUBROUTINE S01380(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00241,
     *  V00236,
     *  U00241,
     *  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 C00241(SSZ(39),SSZ(30),SSZ(40))
      REAL V00236(SSZ(39),SSZ(30),SSZ(40))
      REAL U00241(SSZ(39),SSZ(30),SSZ(40))
      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 "aQPUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(40)
      DO 2 I00002=1,SSZ(30)
      DO 1 I00001=1,SSZ(39)
      U00241(I00001,I00002,I00003)=C00241(I00001,I00002,I00003)*
     *  (V00236(I00001,I00002,I00003)/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00241),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(241),KSTEP,NSTEP,METHOD,
     *    SSZ(39),SSZ(30),SSZ(40),1,
     *    1,1,1,
     *    SSZ(39),SSZ(30),SSZ(40),1,
     *    1,1,1,
     *    C00241,U00241,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 "aQPUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01380')
      RETURN
      END
      SUBROUTINE S01381(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00242,
     *  U00242,
     *  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 C00242(SSZ(39),SSZ(30),SSZ(40))
      REAL U00242(SSZ(39),SSZ(30),SSZ(40))
      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 "aPHIUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(40)
      DO 2 I00002=1,SSZ(30)
      DO 1 I00001=1,SSZ(39)
      U00242(I00001,I00002,I00003)=C00242(I00001,I00002,I00003)*
     *  (0.0/100.0 )
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00242),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(242),KSTEP,NSTEP,METHOD,
     *    SSZ(39),SSZ(30),SSZ(40),1,
     *    1,1,1,
     *    SSZ(39),SSZ(30),SSZ(40),1,
     *    1,1,1,
     *    C00242,U00242,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 "aPHIUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01381')
      RETURN
      END
      SUBROUTINE S01382(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00243,
     *  V00238,
     *  U00243,
     *  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 C00243(SSZ(39),SSZ(40))
      REAL V00238(SSZ(39),SSZ(40))
      REAL U00243(SSZ(39),SSZ(40))
      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 "aEPSINUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(40)
      DO 1 I00001=1,SSZ(39)
      U00243(I00001,I00002)=C00243(I00001,I00002)*
     *  (V00238(I00001,I00002)/100.0 )
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00243),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(243),KSTEP,NSTEP,METHOD,
     *    SSZ(39),SSZ(40),1,1,
     *    1,1,1,
     *    SSZ(39),SSZ(40),1,1,
     *    1,1,1,
     *    C00243,U00243,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 "aEPSINUP"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01382')
      RETURN
      END
      SUBROUTINE S01383(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00250,
     *  V00240,
     *  U00250,
     *  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 C00250(SSZ(39),SSZ(40),SSZ(37))
      REAL V00240(SSZ(39),SSZ(40),SSZ(37))
      REAL U00250(SSZ(39),SSZ(40),SSZ(37))
      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 "STRATHCOUNT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(37)
      DO 2 I00002=1,SSZ(40)
      DO 1 I00001=1,SSZ(39)
      U00250(I00001,I00002,I00003)=V00240(I00001,I00002,I00003)
    1 CONTINUE
    2 CONTINUE
    3 CONTINUE
      CALL GPARW(SIZE(C00250),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(250),KSTEP,NSTEP,METHOD,
     *    SSZ(39),SSZ(40),SSZ(37),1,
     *    1,1,1,
     *    SSZ(39),SSZ(40),SSZ(37),1,
     *    1,1,1,
     *    C00250,U00250,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 "STRATHCOUNT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01383')
      RETURN
      END
      SUBROUTINE S01384(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00251,
     *  V00241,
     *  U00251,
     *  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 C00251(SSZ(39),SSZ(40))
      REAL V00241(SSZ(39),SSZ(40))
      REAL U00251(SSZ(39),SSZ(40))
      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 "REGHCOUNT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(40)
      DO 1 I00001=1,SSZ(39)
      U00251(I00001,I00002)=V00241(I00001,I00002)
    1 CONTINUE
    2 CONTINUE
      CALL GPARW(SIZE(C00251),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(251),KSTEP,NSTEP,METHOD,
     *    SSZ(39),SSZ(40),1,1,
     *    1,1,1,
     *    SSZ(39),SSZ(40),1,1,
     *    1,1,1,
     *    C00251,U00251,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 "REGHCOUNT"',
     *  ' ',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01384')
      RETURN
      END
      SUBROUTINE M00035(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 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',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',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',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',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''',
     *    'FLINC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01363(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00199,
     *  V00016,V00023,
     *  U00199,
     *  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',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',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',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',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',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',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''',
     *    'OFFInc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01370(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00209,
     *  V00022,V00154,
     *  U00209,
     *  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''',
     *    'aUCONSUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01371(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00223,
     *  V00228,
     *  U00223,
     *  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''',
     *    'aQUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01372(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00224,
     *  V00229,
     *  U00224,
     *  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''',
     *    'aPHIUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01373(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00225,
     *  V00230,
     *  U00225,
     *  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''',
     *    'aEPSINUSA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01374(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00226,
     *  V00231,
     *  U00226,
     *  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',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''',
     *    'aQUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01376(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00234,
     *  V00232,
     *  U00234,
     *  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''',
     *    'aPHIUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01377(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00235,
     *  V00233,
     *  U00235,
     *  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''',
     *    'aEPSINUSAEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01378(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00236,
     *  V00234,
     *  U00236,
     *  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
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'aQPUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01380(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00241,
     *  V00236,
     *  U00241,
     *  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''',
     *    'aPHIUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01381(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00242,
     *  U00242,
     *  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''',
     *    'aEPSINUP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01382(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00243,
     *  V00238,
     *  U00243,
     *  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''',
     *    'STRATHCOUNT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01383(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00250,
     *  V00240,
     *  U00250,
     *  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''',
     *    'REGHCOUNT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01384(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,
     *  C00251,
     *  V00241,
     *  U00251,
     *  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
      RETURN
15000 CALL PERET('M00035')
      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'
