C This code was written by the program
C <TABLO  Version 6.4   April 2012>
      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 mslave
      use gpjobs, only: GPLaunchJob,
     *   GPIsJobDone, GetNumLogicalProc, GPSLEEP
      use gpmanref, only: manreftt
      use tbtgcom1
      use gtap_
      include 'tggsdec1.for'
      CHARACTER*70 PROGNV
      PARAMETER(PROGNV=
     *'<gtap.for 12-MAY-2016 (a TABLO-generated program)>')
      INTEGER PRVERI
      PARAMETER(PRVERI=41000)
      CHARACTER (LEN=9) DATES
      PARAMETER(DATES='1987-2010')
      CHARACTER*6 PRNAME
      PARAMETER(PRNAME='TGPROG')
      INTEGER DMMTOG
C Map from coefficient names in code to names in model specification
C
C      Name in code       Name used in model specification
C      ---------------------------------------------------
C         C00001            VERNUM
C         C00002            SIZE_TRAD
C         C00003            SIZE_ENDW
C         C00004            SIZE_DEMD
C         C00005            SIZE_CGDS
C         C00006            SIZE_PROD
C         C00007            SLUG
C         C00008            REGTOBLOC
C         C00009            SAVE
C         C00010            VDGA
C         C00011            VDGANC
C         C00012            VDGM
C         C00013            VIGA
C         C00014            VIGANC
C         C00015            VIGM
C         C00016            VDPA
C         C00017            VDPANC
C         C00018            VDPM
C         C00019            VIPA
C         C00020            VIPANC
C         C00021            VIPM
C         C00022            EVOA
C         C00023            EVFA
C         C00024            VDFA
C         C00025            VDFANC
C         C00026            VIFA
C         C00027            VIFANC
C         C00028            VFM
C         C00029            VIFM
C         C00030            VDFM
C         C00031            VDEP
C         C00032            VIMS
C         C00033            VIWS
C         C00034            VXWD
C         C00035            VXMD
C         C00036            VST
C         C00037            CO2DF
C         C00038            CO2IF
C         C00039            CO2DG
C         C00040            CO2IG
C         C00041            CO2DP
C         C00042            CO2IP
C         C00043            NCTAXLEV
C         C00044            VFAD
C         C00045            VOA
C         C00046            VDM
C         C00047            VOM
C         C00048            VGAT
C         C00049            GOVEXP
C         C00050            VPAT
C         C00051            PRIVEXP
C         C00052            INCOME
C         C00053            DFTAX
C         C00054            DFCTAX
C         C00055            IFTAX
C         C00056            IFCTAX
C         C00057            TIU
C         C00058            DPTAX
C         C00059            DPCTAX
C         C00060            IPTAX
C         C00061            IPCTAX
C         C00062            TPC
C         C00063            DGTAX
C         C00064            DGCTAX
C         C00065            IGTAX
C         C00066            IGCTAX
C         C00067            TGC
C         C00068            ETAX
C         C00069            TFU
C         C00070            PTAX
C         C00071            TOUT
C         C00072            XTAXD
C         C00073            TEX
C         C00074            MTAX
C         C00075            TIM
C         C00076            ESUBD
C         C00077            REGINV
C         C00078            NETINV
C         C00079            GLOBINV
C         C00080            UELASPRIV
C         C00081            CO2
C         C00082            CO2T
C         C00083            CO2TB
C         C00084            VGA
C         C00085            VGAS
C         C00086            SHVDGANC
C         C00087            CO2DGVDGA
C         C00088            SHVIGANC
C         C00089            CO2IGVIGA
C         C00090            GMSHR
C         C00091            GSIZE_ENY
C         C00092            GSHENY
C         C00093            ELGENY
C         C00094            GSIZE_NENY
C         C00095            GSHNENY
C         C00096            ELGNENY
C         C00097            ELGUG
C         C00098            VPA
C         C00099            VPAS
C         C00100            SHVDPANC
C         C00101            CO2DPVDPA
C         C00102            SHVIPANC
C         C00103            CO2IPVIPA
C         C00104            PMSHR
C         C00105            PSIZE_ENY
C         C00106            PSHENY
C         C00107            ELPENY
C         C00108            INCPAR
C         C00109            SUBPAR
C         C00110            PSHUP
C         C00111            ALPHA
C         C00112            APE
C         C00113            EY
C         C00114            EP
C         C00115            XWCONSHR
C         C00116            VFA
C         C00117            VFAS
C         C00118            VFAE
C         C00119            SHVDFANC
C         C00120            CO2DFVDFA
C         C00121            SHVIFANC
C         C00122            CO2IFVIFA
C         C00123            FMSHR
C         C00124            FSIZE_NCOAL
C         C00125            FSHNCOAL
C         C00126            ELFNCOAL
C         C00127            FSIZE_NELY
C         C00128            FSHNELY
C         C00129            ELFNELY
C         C00130            FSIZE_ENY
C         C00131            FSHENY
C         C00132            ELFENY
C         C00133            FSIZE_KEN
C         C00134            FSHKEN
C         C00135            ELFKEN
C         C00136            FSIZE_VAEN
C         C00137            FSHVAEN
C         C00138            ELFVAEN
C         C00139            FSIZE_EBL
C         C00140            FSHEBL
C         C00141            ELFEBL
C         C00142            FSIZE_EPP
C         C00143            FSHEPP
C         C00144            ELFEPP
C         C00145            FSIZE_EGEN
C         C00146            FSHEGEN
C         C00147            ELFEGEN
C         C00148            FSIZE_ELYO
C         C00149            FSHELYO
C         C00150            ELFELYO
C         C00151            ESUBT
C         C00152            VFATOT
C         C00153            FSIZE_OUT
C         C00154            FSHOUT
C         C00155            VKB
C         C00156            INVKERATIO
C         C00157            GRNETRATIO
C         C00158            RORFLEX
C         C00159            RORDELTA
C         C00160            MSHRS
C         C00161            ESUBM
C         C00162            VTMFSD
C         C00163            VTFSD
C         C00164            VTMUSE
C         C00165            VTMPROV
C         C00166            VTRPROV
C         C00167            VT
C         C00168            VTMUSESHR
C         C00169            VTSUPPSHR
C         C00170            VTUSE
C         C00171            VTFSD_MSH
C         C00172            VIWSCOST
C         C00173            FOBSHR
C         C00174            TRNSHR
C         C00175            CO2Q
C         C00176            CO2QB
C         C00177            XSHRPRIV
C         C00178            XSHRGOV
C         C00179            XSHRSAVE
C         C00180            TINC
C         C00181            REVSHR
C         C00182            ETRAE
C         C00183            PIND
C         C00184            INCOMEB
C         C00185            PINDB
C         C00186            NCTAXLEVB
C         C00187            CTGSHARE
C         C00188            FY
C         C00189            INDTAX
C         C00190            DPARSUM
C         C00191            UTILELAS
C         C00192            DPARPRIV
C         C00193            DPARGOV
C         C00194            DPARSAVE
C         C00195            UTILPRIV
C         C00196            UTILGOV
C         C00197            UTILSAVE
C         C00198            SHRDFM
C         C00199            SHRDPM
C         C00200            SHRDGM
C         C00201            SHRDM
C         C00202            SHRST
C         C00203            SHRXMD
C         C00204            VIM
C         C00205            SHRIFM
C         C00206            SHRIPM
C         C00207            SHRIGM
C         C00208            SHREM
C         C00209            VXW
C         C00210            VXWREGION
C         C00211            VIW
C         C00212            VIWREGION
C         C00213            VENDWREG
C         C00214            VENDWWLD
C         C00215            GDP
C         C00216            VXWCOMMOD
C         C00217            VXWLD
C         C00218            VIWCOMMOD
C         C00219            PW_PM
C         C00220            VOW
C         C00221            VWOW
C         C00222            VWOU
C         C00223            TBALCTRA
C         C00224            TBAL
C         C00225            TOTDEM
C         C00226            INCOMEEV
C         C00227            UTILPRIVEV
C         C00228            UTILGOVEV
C         C00229            UTILSAVEEV
C         C00230            VPAEV
C         C00231            VPAREGEV
C         C00232            CONSHREV
C         C00233            EYEV
C         C00234            UELASPRIVEV
C         C00235            XWCONSHREV
C         C00236            PRIVEXPEV
C         C00237            GOVEXPEV
C         C00238            SAVEEV
C         C00239            XSHRPRIVEV
C         C00240            XSHRGOVEV
C         C00241            XSHRSAVEEV
C         C00242            UTILELASEV
C         C00243            EVSCALFACT
C         C00244            VTMD
C         C00245            SX_IR
C         C00246            VTICOMM
C         C00247            VIWDIRALL
C         C00248            VIWDATOT
C         C00249            SM_IR
C         C00250            SX_IRS
C         C00251            SXT_IR
C         C00252            SM_IRS
C         C00253            SMT_IR
C         C00254            SW_IR
C         C00255            SW_I
C         C00256            C00256
C         C00257            C00257
C         C00258            C00258
C         C00259            C00259
C         C00260            C00260
C         C00261            C00261
C         C00262            C00262
C         C00263            C00263
C         C00264            C00264
C         C00265            C00265
C         C00266            C00266
C         C00267            C00267
C         C00268            C00268
C         C00269            C00269
C         C00270            C00270
C         C00271            C00271
C         C00272            C00272
C         C00273            C00273
C         C00274            C00274
C         C00275            C00275
C         C00276            C00276
C         C00277            C00277
C         C00278            C00278
C         C00279            C00279
C         C00280            C00280
C         C00281            C00281
C         C00282            C00282
C         C00283            C00283
C         C00284            C00284
C         C00285            C00285
C         C00286            C00286
C         C00287            C00287
C         C00288            C00288
C         C00289            C00289
C         C00290            C00290
C         C00291            C00291
C         C00292            C00292
C         C00293            C00293
C         C00294            C00294
C         C00295            C00295
C         C00296            C00296
C         C00297            C00297
C         C00298            C00298
C         C00299            C00299
C         C00300            C00300
C         C00301            C00301
C         C00302            C00302
C         C00303            C00303
C         C00304            C00304
C         C00305            C00305
C         C00306            C00306
C         C00307            C00307
C         C00308            C00308
C         C00309            C00309
C         C00310            C00310
C         C00311            C00311
C         C00312            C00312
C         C00313            C00313
C         C00314            C00314
C         C00315            C00315
C         C00316            C00316
C         C00317            C00317
C         C00318            C00318
C         C00319            C00319
C         C00320            C00320
C         C00321            C00321
C         C00322            C00322
C         C00323            C00323
C         C00324            C00324
C         C00325            C00325
C         C00326            C00326
C         C00327            C00327
C         C00328            C00328
C         C00329            C00329
C         C00330            C00330
C         C00331            C00331
C         C00332            C00332
C         C00333            C00333
C         C00334            C00334
C         C00335            C00335
C         C00336            C00336
C         C00337            C00337
C         C00338            C00338
C         C00339            C00339
C         C00340            C00340
C         C00341            C00341
C         C00342            C00342
C         C00343            C00343
C         C00344            C00344
C         C00345            C00345
C         C00346            C00346
C         C00347            C00347
C         C00348            C00348
C         C00349            C00349
C         C00350            C00350
C         C00351            C00351
C         C00352            C00352
C         C00353            C00353
C         C00354            C00354
C         C00355            C00355
C         C00356            C00356
C         C00357            C00357
C         C00358            C00358
C         C00359            C00359
C         C00360            C00360
C         C00361            C00361
C         C00362            C00362
C         C00363            C00363
C         C00364            C00364
C         C00365            C00365
C         C00366            C00366
C         C00367            C00367
C         C00368            C00368
C         C00369            C00369
C         C00370            C00370
C         C00371            C00371
C         C00372            C00372
C         C00373            C00373
C         C00374            C00374
C         C00375            C00375
C         C00376            C00376
C         C00377            C00377
C
C Declarations of all coefficients
C      REAL C00001(1),C00002(1),C00003(1),C00004(1),C00005(1),C00006(1)
C      INTEGER C00007(0),C00008(0)
C      REAL C00009(0),C00010(0,0),C00011(0,0),C00012(0,0),C00013(0,0)
C      REAL C00014(0,0),C00015(0,0),C00016(0,0),C00017(0,0),C00018(0,0)
C      REAL C00019(0,0),C00020(0,0),C00021(0,0),C00022(0,0)
C      REAL C00023(0,0,0),C00024(0,0,0),C00025(0,0,0),C00026(0,0,0)
C      REAL C00027(0,0,0),C00028(0,0,0),C00029(0,0,0),C00030(0,0,0)
C      REAL C00031(0),C00032(0,0,0),C00033(0,0,0),C00034(0,0,0)
C      REAL C00035(0,0,0),C00036(0,0),C00037(0,0,0),C00038(0,0,0)
C      REAL C00039(0,0),C00040(0,0),C00041(0,0),C00042(0,0),C00043(0)
C      REAL C00044(0,0,0),C00045(0,0),C00046(0,0),C00047(0,0)
C      REAL C00048(0,0),C00049(0),C00050(0,0),C00051(0),C00052(0)
C      REAL C00053(0,0,0),C00054(0,0,0),C00055(0,0,0),C00056(0,0,0)
C      REAL C00057(0),C00058(0,0),C00059(0,0),C00060(0,0),C00061(0,0)
C      REAL C00062(0),C00063(0,0),C00064(0,0),C00065(0,0),C00066(0,0)
C      REAL C00067(0),C00068(0,0,0),C00069(0),C00070(0,0),C00071(0)
C      REAL C00072(0,0,0),C00073(0),C00074(0,0,0),C00075(0),C00076(0)
C      REAL C00077(0),C00078(0),C00079(1),C00080(0),C00081(0,0)
C      REAL C00082(0),C00083(0),C00084(0,0),C00085(2,0),C00086(0,0)
C      REAL C00087(0,0),C00088(0,0),C00089(0,0),C00090(0,0),C00091(1)
C      REAL C00092(16,0),C00093(0),C00094(1),C00095(0,0),C00096(0)
C      REAL C00097(0),C00098(0,0),C00099(1,0),C00100(0,0),C00101(0,0)
C      REAL C00102(0,0),C00103(0,0),C00104(0,0),C00105(1),C00106(16,0)
C      REAL C00107(0),C00108(0,0),C00109(0,0),C00110(0,0),C00111(0,0)
C      REAL C00112(0,0,0),C00113(0,0),C00114(0,0,0),C00115(0,0)
C      REAL C00116(0,0,0),C00117(5,0,0),C00118(4,0,0),C00119(0,0,0)
C      REAL C00120(0,0,0),C00121(0,0,0),C00122(0,0,0),C00123(0,0,0)
C      REAL C00124(1),C00125(3,0,0),C00126(0,0),C00127(1),C00128(2,0,0)
C      REAL C00129(0,0),C00130(1),C00131(2,0,0),C00132(0,0),C00133(1)
C      REAL C00134(2,0,0),C00135(0,0),C00136(1),C00137(0,0,0)
C      REAL C00138(0,0),C00139(1),C00140(7,0,0),C00141(0,0),C00142(1)
C      REAL C00143(4,0,0),C00144(0,0),C00145(1),C00146(2,0,0)
C      REAL C00147(0,0),C00148(1),C00149(2,0,0),C00150(0,0),C00151(0)
C      REAL C00152(0,0),C00153(1),C00154(0,0,0),C00155(0),C00156(0)
C      REAL C00157(0),C00158(0)
C      INTEGER C00159(1)
C      REAL C00160(0,0,0),C00161(0),C00162(0,0,0,0),C00163(0,0,0)
C      REAL C00164(0),C00165(0),C00166(0),C00167(1),C00168(0,0,0,0)
C      REAL C00169(0,0),C00170(1),C00171(0,0,0,0),C00172(0,0,0)
C      REAL C00173(0,0,0),C00174(0,0,0),C00175(0),C00176(0),C00177(0)
C      REAL C00178(0),C00179(0),C00180(0),C00181(0,0,0),C00182(0)
C      REAL C00183(0),C00184(0),C00185(0),C00186(0),C00187(0),C00188(0)
C      REAL C00189(0),C00190(0),C00191(0),C00192(0),C00193(0),C00194(0)
C      REAL C00195(0),C00196(0),C00197(0),C00198(0,0,0),C00199(0,0)
C      REAL C00200(0,0),C00201(0,0),C00202(0,0),C00203(0,0,0)
C      REAL C00204(0,0),C00205(0,0,0),C00206(0,0),C00207(0,0)
C      REAL C00208(0,0,0),C00209(0,0),C00210(0),C00211(0,0),C00212(0)
C      REAL C00213(0),C00214(1),C00215(0),C00216(0),C00217(1),C00218(0)
C      REAL C00219(0,0),C00220(0,0),C00221(0),C00222(0),C00223(0)
C      REAL C00224(0),C00225(4,0),C00226(0),C00227(0),C00228(0)
C      REAL C00229(0),C00230(0,0),C00231(0),C00232(0,0),C00233(0,0)
C      REAL C00234(0),C00235(0,0),C00236(0),C00237(0),C00238(0)
C      REAL C00239(0),C00240(0),C00241(0),C00242(0),C00243(0)
C      REAL C00244(0,0),C00245(0,0),C00246(0,0),C00247(0,0),C00248(0)
C      REAL C00249(0,0),C00250(0,0,0),C00251(0,0),C00252(0,0,0)
C      REAL C00253(0,0),C00254(0,0),C00255(0),C00256(0),C00257(0)
C      REAL C00258(0),C00259(0),C00260(0),C00261(0),C00262(0)
C      REAL C00263(0,0),C00264(0),C00265(0),C00266(0),C00267(0)
C      REAL C00268(0),C00269(0),C00270(0),C00271(0),C00272(4,0)
C      REAL C00273(4,0),C00274(4,0),C00275(4,0),C00276(0,0),C00277(0,0)
C      REAL C00278(0,0),C00279(0,0),C00280(0,0),C00281(0),C00282(0,0)
C      REAL C00283(0,0),C00284(0,0),C00285(4,0),C00286(4,0),C00287(4,0)
C      REAL C00288(4,0),C00289(4,0),C00290(4,0),C00291(0,0),C00292(0,0)
C      REAL C00293(0),C00294(0,0),C00295(0,0),C00296(0),C00297(0)
C      REAL C00298(0,0),C00299(0,0),C00300(0,0),C00301(0),C00302(0)
C      REAL C00303(0,0),C00304(0,0),C00305(0,0),C00306(0,0),C00307(0,0)
C      REAL C00308(0,0),C00309(0,0),C00310(0,0),C00311(0,0),C00312(0,0)
C      REAL C00313(0,0),C00314(0,0),C00315(0),C00316(0,0),C00317(0,0)
C      REAL C00318(0),C00319(0,0),C00320(0),C00321(0,0),C00322(0,0)
C      REAL C00323(0,0),C00324(0,0),C00325(0,0),C00326(0,0),C00327(0,0)
C      REAL C00328(0,0),C00329(0,0),C00330(0,0),C00331(0,0),C00332(0,0)
C      REAL C00333(0,0),C00334(0,0),C00335(0,0),C00336(0,0),C00337(0)
C      REAL C00338(0,0),C00339(0,0),C00340(0,0),C00341(0,0),C00342(0,0)
C      REAL C00343(0),C00344(0,0),C00345(0,0),C00346(0,0),C00347(0,0,0)
C      REAL C00348(0,0),C00349(0,0),C00350(0,0),C00351(0),C00352(0,0)
C      REAL C00353(0,0),C00354(0,0),C00355(0),C00356(0,0,0),C00357(0,0)
C      REAL C00358(0,0,0),C00359(0,0),C00360(0,0),C00361(0,0)
C      REAL C00362(0,0),C00363(0),C00364(0,0),C00365(0,0),C00366(0,0)
C      REAL C00367(0,0),C00368(0),C00369(0,0),C00370(0,0),C00371(0,0)
C      REAL C00372(0,0),C00373(0),C00374(0,0),C00375(0,0,0),C00376(0,0)
C      REAL C00377(0,0,0)
C Finish of declarations of all coefficients
C Map from index names in code to names in model specification
C
C      Name in code       Name used in model specification
C      ---------------------------------------------------
C         I00001            i
C         I00002            r
C         I00003            s
C         I00004            j
C         I00005            m
C         I00006            b
C         I00007            h
C         I00008            k
C         I00009            n
C         I00010            l
C         I00011            XX01
      istgprog=.TRUE.
      isgemsim=.NOT.istgprog
      dmmtog=0
      mxgsrs=0
      mxgsis=0
      mxgslg=0
      mxgsop=0
      mxgsin=0
      mxgsrc=0
      mxgsic=0
      AXSFIL='gtap'
      AXTFIL=AXSFIL
      include 'tggscod1.for'
      IF(DEBG(26).EQ.0) THEN
       CALL TGCAXD('tg',DATEXS,DATEXT,AXTUN,
     *   'at 10:04:35 on 12-MAY-2016              ',ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      include 'tggscod2.for'
      include 'tggscod3.for'
      include 'tggscod4.for'
      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(USOEBC.AND.KSINTA.EQ.1.AND.KSTEPA.EQ.1.AND.
     *  KMSTSL.EQ.1) THEN
        GOTO 6412
      ELSE
        IF(.NOT.DOCBC) GOTO 3000
      END IF
      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(KSINTA.EQ.1.AND.(PGDSIM.OR.DOSHCK).AND.FSTPAS.AND.NOXSSW
     *    .AND.ISFNLV.AND.(.NOT.SHDONE)) THEN
      include 'tggsshk1.for'
      END IF
      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(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(LSACTP.EQ.SHACTP.AND.LSACNO.GE.SHACNO) THEN
      include 'tggsshk1.for'
       END IF
      END IF
      IF(USOEBC) THEN
        GOTO 6412
      ELSE
        IF(.NOT.DOCBC) GOTO 3000
      END IF
      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 M00031(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 GPRELAPS('Elapsed time for equations is:',
     *    ' ',' ',' ',
     *    StartYearNo7,StartDayNo7,StartSecondsNo7,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
        CALL GPRELAPS('Elapsed time for formulas and equations is:',
     *    ' ',' ',' ',
     *    StartYearNo4,StartDayNo4,StartSecondsNo4,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 POSFIL(AXSUN,'BBSL',TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00032(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  AXSUN,CWKUN,
     *  FSTPAS,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00033(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  AXSUN,CWKUN,
     *  FSTPAS,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL M00034(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  AXSUN,CWKUN,
     *  FSTPAS,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 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
      CALL M00036(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 M00037(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,RTSIOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,NELTX,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) GOTO 8260
      include 'tggsud1.for'
 8260 CONTINUE
      include 'tggsud2.for'
      GOTO 5900
5850  CONTINUE
      include 'tggspre1.for'
      include 'tggspre2.for'
      include 'tggsei0.for'
      include 'tggsudx1.for'
 8300 CONTINUE
      include 'tggsei1.for'
8360  CONTINUE
      include 'tggsecp1.for'
      include 'tggsend1.for'
8100  CONTINUE
      include 'tggsend2.for'
9000  CONTINUE
      include 'tggsend3.for'
      END
      SUBROUTINE S00001(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00002,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00002(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SIZE_TRAD"'
      CurrentAction2=
     *  'at line 257 in the TAB file'
      CurrentIGNO=27
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_TRAD"',
     *  'at line 257 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,TRAD_COMM
      C00002(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SIZE_TRAD"',
     *  'at line 257 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00003,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00003(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SIZE_ENDW"'
      CurrentAction2=
     *  'at line 261 in the TAB file'
      CurrentIGNO=29
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_ENDW"',
     *  'at line 261 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,ENDW_COMM
      C00003(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SIZE_ENDW"',
     *  'at line 261 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00004,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00004(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SIZE_DEMD"'
      CurrentAction2=
     *  'at line 265 in the TAB file'
      CurrentIGNO=31
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_DEMD"',
     *  'at line 265 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(8)  ! SUM(i,DEMD_COMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,DEMD_COMM
      C00004(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SIZE_DEMD"',
     *  'at line 265 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00002,C00003,C00004,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE TGBAS1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER ASSVAL,MMEL,ELAD(MMNST)
      LOGICAL ASSOK
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL LG1
      INTEGER IS1
      LOGICAL ECHO1
      REAL C00002(1)
      REAL C00003(1)
      REAL C00004(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'assertion'
      CurrentAction2=
     *  'at line 267 in the TAB file'
      CurrentIGNO=32
      CurrentIGTP='as'
      CALL GPAPRW(
     *  ' before calculating assertion',
     *  'at line 267 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      ASSOK=.TRUE.
      NumASSFailPos=0
      IS1=0
      LG1=C00004(1).EQ.C00002(1)+C00003(1)
      IF(LG1) THEN
      IS1=1
      END IF
      ASSVAL=IS1
      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(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating assertion',
     *  'at line 267 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.ASSOK) THEN
       CALL TGASF2('tg',
     *' ',
     *   ASSOK,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00005,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00005(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SIZE_CGDS"'
      CurrentAction2=
     *  'at line 272 in the TAB file'
      CurrentIGNO=34
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_CGDS"',
     *  'at line 272 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(5)  ! SUM(i,CGDS_COMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,CGDS_COMM
      C00005(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SIZE_CGDS"',
     *  'at line 272 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00006,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00006(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SIZE_PROD"'
      CurrentAction2=
     *  'at line 276 in the TAB file'
      CurrentIGNO=36
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SIZE_PROD"',
     *  'at line 276 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(7)  ! SUM(i,PROD_COMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,PROD_COMM
      C00006(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SIZE_PROD"',
     *  'at line 276 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00002,C00005,C00006,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE TGBAS1
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER ASSVAL,MMEL,ELAD(MMNST)
      LOGICAL ASSOK
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL LG1
      INTEGER IS1
      LOGICAL ECHO1
      REAL C00002(1)
      REAL C00005(1)
      REAL C00006(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'assertion'
      CurrentAction2=
     *  'at line 278 in the TAB file'
      CurrentIGNO=37
      CurrentIGTP='as'
      CALL GPAPRW(
     *  ' before calculating assertion',
     *  'at line 278 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      ASSOK=.TRUE.
      NumASSFailPos=0
      IS1=0
      LG1=C00006(1).EQ.C00002(1)+C00005(1)
      IF(LG1) THEN
      IS1=1
      END IF
      ASSVAL=IS1
      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(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating assertion',
     *  'at line 278 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.ASSOK) THEN
       CALL TGASF2('tg',
     *' ',
     *   ASSOK,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00007,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL LG1
      INTEGER IS1
      LOGICAL ECHO1
      INTEGER C00007(SSZ(6))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      LOGICAL RUNTSS,PRELIM,DOPRE,DIDPRE
      INTEGER NSSMP
      COMMON /TGPREI/DOPRE,PRELIM,DIDPRE
      COMMON /TGTPSI/NSSMP,RUNTSS
      IER=0
      CurrentAction=
     *  'formula for set "ENDWS_COMM"'
      CurrentAction2=
     *  'at line 292 in the TAB file'
      CurrentIGNO=41
      CurrentIGTP='st'
      CALL GPAPRW(
     *  ' before calculating formula for set "ENDWS_COMM"',
     *  'at line 292 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IF((PRELIM.OR.POSTSIMPASS2).AND.RUNTSS) THEN
        SSMPST(10)=NSSMP+1
        CALL TGINCP(NSSMP+SSZ(6),DSSMP,'DSSMP',ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      IS1=0
      LG1=C00007(I00001).GT.0
      IF(LG1) THEN
      IS1=1
      END IF
      SSMP(SSMPST(10)-1+I00001)=IS1
    1 CONTINUE  ! END (all,i,ENDW_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for set "ENDWS_COMM"',
     *  'at line 292 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00008')
      RETURN
      END
      SUBROUTINE M00001(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(PRELIM) THEN
       CALL SSAL1C(1,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(2,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(3,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(4,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(5,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(6,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(79,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(91,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(105,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(127,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(133,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(139,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(145,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(153,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(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(214,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(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=0
      END IF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(8,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(9,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(31,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(43,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(49,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(51,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(52,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(57,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(62,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(67,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(69,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(71,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(73,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(75,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(77,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(78,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(80,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(93,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(96,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(97,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(107,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(157,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(166,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(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(183,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(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(210,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(215,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(223,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(224,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(226,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(231,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(236,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(237,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(238,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(239,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(248,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) THEN
       CALL SSAL1C(259,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(264,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(265,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(266,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(267,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(268,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(269,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(270,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(271,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(281,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(293,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(296,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(297,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(301,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(315,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(320,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(337,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(350,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(351,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(354,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(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(372,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(373,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(10,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(11,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(12,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(13,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(14,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(15,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(16,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(17,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(18,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(19,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(20,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(21,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(32,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(33,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(34,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(35,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(39,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(40,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(41,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(42,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(46,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(48,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(50,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(58,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(59,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(60,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(61,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(63,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(64,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(65,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(66,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(72,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(74,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(76,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(81,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(86,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(87,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(88,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(89,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(90,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(102,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(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(163,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(199,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(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(206,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(207,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(209,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(211,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(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(245,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(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(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(263,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(278,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(279,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(280,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(282,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(283,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(284,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(292,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(294,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(295,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(298,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(299,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(300,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(323,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(324,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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
      IF(PRELIM) THEN
       CALL SSAL1C(328,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(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(342,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(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(359,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(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
      IF(PRELIM) THEN
       CALL SSAL1C(376,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(36,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(162,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(164,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(165,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(171,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(244,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(251,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(253,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(338,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(343,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(348,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(352,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(356,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(360,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(365,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
      IF(PRELIM) THEN
       CALL SSAL1C(370,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(374,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(375,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(377,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=3
       SSNO=1
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,1,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(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(340,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(341,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=4
       SSNO=2
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,2,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(7,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(22,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(182,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(321,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(322,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(23,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(24,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(25,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(26,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(27,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(28,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(29,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(30,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(37,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(38,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(53,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(54,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(55,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(56,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(68,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(119,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(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(123,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(129,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(135,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(138,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(141,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(144,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(150,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(151,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(152,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(181,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(205,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(303,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(304,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(305,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(306,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(307,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(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(314,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=2
       SSNO=3
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,3,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=5
       SSNO=4
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,4,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(44,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=6
       SSNO=5
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,5,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=2
       SSNO=6
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,6,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(45,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(47,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(70,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=8
       SSNO=7
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,7,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=5
       SSNO=8
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,8,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=7
       SSNO=9
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,9,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(27).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_TRAD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(27).NE.'n') then
      CALL S00001(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(27),
     *  C00002,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(29).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_ENDW',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(29).NE.'n') then
      CALL S00002(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(29),
     *  C00003,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(31).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_DEMD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(31).NE.'n') then
      CALL S00003(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(31),
     *  C00004,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(32).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
      CALL GPTO1(' Assertion at line number %i',
     *  ' ',267,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(32).NE.'n') then
      CALL S00004(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(32),
     *  C00002,C00003,C00004,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(34).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_CGDS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(34).NE.'n') then
      CALL S00005(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(34),
     *  C00005,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(36).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SIZE_PROD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(36).NE.'n') then
      CALL S00006(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(36),
     *  C00006,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(37).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
      CALL GPTO1(' Assertion at line number %i',
     *  ' ',278,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(37).NE.'n') then
      CALL S00007(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(37),
     *  C00002,C00005,C00006,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(41).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(41).NE.'n') then
      CALL S00008(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(41),
     *  C00007,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=10
       SSNO=10
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,10,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(208,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.OR.POSTSIMPASS2) THEN
       LITSN=11
       SSNO=11
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,11,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=12
       SSNO=12
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,12,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=13
       SSNO=13
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,13,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=14
       SSNO=14
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,14,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(225,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(285,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(286,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(287,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(288,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(289,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(290,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=15
       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=16
       SSNO=16
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,16,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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(83,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(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(186,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.FSTPAS) THEN
        CALL TGRMPE(3,'MAPB',SSZ(1),SSZ(17),
     *    SSZ(1),'REGTOBLOC   ','REG         ','BLOC        ',
     *    SIZE(C00008),C00008,1,MMEL,STEL,ELAD(17),ELAD(1),
     *  0,1,1,1,1,1,1,
     *  '            ',' ',' ',
     *  DSSMP,SSMP,MMNSS,SSMPST,SSIOS,
     *   RDUN,LFNORD,RDFSNO,MMNFL,AFN,AFS,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00001')
      RETURN
      END
      SUBROUTINE S00009(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00023,C00044,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00023(SSZ(6),SSZ(7),SSZ(1))
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFAD"'
      CurrentAction2=
     *  'at line 918 in the TAB file'
      CurrentIGNO=233
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAD"',
     *  'at line 918 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      C00044(SSMP(SSMPST(5)-1+I00001),I00004,I00002)=
     *  C00023(I00001,I00004,I00002)
    1 CONTINUE  ! END (all,i,ENDW_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFAD"',
     *  'at line 918 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00024,C00026,C00044,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFAD"'
      CurrentAction2=
     *  'at line 920 in the TAB file'
      CurrentIGNO=234
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAD"',
     *  'at line 920 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)=
     *  C00024(I00001,I00004,I00003)+C00026(I00001,I00004,I00003)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFAD"',
     *  'at line 920 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00022,C00045,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00022(SSZ(6),SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VOA"'
      CurrentAction2=
     *  'at line 925 in the TAB file'
      CurrentIGNO=236
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOA"',
     *  'at line 925 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)=
     *  C00022(I00001,I00002)
    1 CONTINUE  ! END (all,i,ENDW_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VOA"',
     *  'at line 925 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00044,C00045,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VOA"'
      CurrentAction2=
     *  'at line 927 in the TAB file'
      CurrentIGNO=237
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOA"',
     *  'at line 927 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(8)  ! SUM(j,DEMD_COMM
      RS1=RS1+C00044(I00004,I00001,I00002)
    3 CONTINUE  ! END SUM(j,DEMD_COMM
      C00045(SSMP(SSMPST(9)-1+I00001),I00002)=RS1
    1 CONTINUE  ! END (all,i,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VOA"',
     *  'at line 927 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00012,C00018,C00030,C00046,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00012(SSZ(2),SSZ(1))
      REAL C00018(SSZ(2),SSZ(1))
      REAL C00030(SSZ(2),SSZ(7),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VDM"'
      CurrentAction2=
     *  'at line 932 in the TAB file'
      CurrentIGNO=239
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VDM"',
     *  'at line 932 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00030(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00046(I00001,I00002)=C00018(I00001,I00002)+C00012(I00001,I00002)+
     *  RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VDM"',
     *  'at line 932 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00028,C00047,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00028(SSZ(6),SSZ(7),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VOM"'
      CurrentAction2=
     *  'at line 937 in the TAB file'
      CurrentIGNO=241
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  'at line 937 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00028(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)=RS1
    1 CONTINUE  ! END (all,i,ENDW_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VOM"',
     *  'at line 937 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00035,C00036,C00046,C00047,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VOM"'
      CurrentAction2=
     *  'at line 939 in the TAB file'
      CurrentIGNO=242
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  'at line 939 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00035(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005))),I00002)=C00046(SSMP(SSMPST(1)-1+I00005),I00002)+RS1+
     *  C00036(I00005,I00002)
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VOM"',
     *  'at line 939 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00035,C00046,C00047,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VOM"'
      CurrentAction2=
     *  'at line 941 in the TAB file'
      CurrentIGNO=243
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  'at line 941 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00035(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001))),I00002)=C00046(SSMP(SSMPST(2)-1+I00001),I00002)+RS1
    1 CONTINUE  ! END (all,i,NMRG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VOM"',
     *  'at line 941 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00045,C00047,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00007
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VOM"'
      CurrentAction2=
     *  'at line 943 in the TAB file'
      CurrentIGNO=244
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOM"',
     *  'at line 943 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00007=1,SSZ(5)  ! (all,h,CGDS_COMM)
      C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)=
     *  C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)
    1 CONTINUE  ! END (all,h,CGDS_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VOM"',
     *  'at line 943 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00010,C00013,C00048,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VGAT"'
      CurrentAction2=
     *  'at line 981 in the TAB file'
      CurrentIGNO=246
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VGAT"',
     *  'at line 981 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00048(I00001,I00003)=C00010(I00001,I00003)+C00013(I00001,I00003)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VGAT"',
     *  'at line 981 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00018')
      RETURN
      END
      SUBROUTINE S00019(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00048,C00049,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00049(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GOVEXP"'
      CurrentAction2=
     *  'at line 985 in the TAB file'
      CurrentIGNO=248
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GOVEXP"',
     *  'at line 985 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00048(I00001,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00049(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GOVEXP"',
     *  'at line 985 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00016,C00019,C00050,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VPAT"'
      CurrentAction2=
     *  'at line 991 in the TAB file'
      CurrentIGNO=250
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPAT"',
     *  'at line 991 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00050(I00001,I00003)=C00016(I00001,I00003)+C00019(I00001,I00003)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VPAT"',
     *  'at line 991 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00050,C00051,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00051(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "PRIVEXP"'
      CurrentAction2=
     *  'at line 995 in the TAB file'
      CurrentIGNO=252
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PRIVEXP"',
     *  'at line 995 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00050(I00001,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00051(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "PRIVEXP"',
     *  'at line 995 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00009,C00049,C00051,C00052,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00049(SSZ(1))
      REAL C00051(SSZ(1))
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "INCOME"'
      CurrentAction2=
     *  'at line 1001 in the TAB file'
      CurrentIGNO=254
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INCOME"',
     *  'at line 1001 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00052(I00002)=C00051(I00002)+C00049(I00002)+C00009(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "INCOME"',
     *  'at line 1001 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00025,C00030,C00053,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00025(SSZ(2),SSZ(7),SSZ(1))
      REAL C00030(SSZ(2),SSZ(7),SSZ(1))
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "DFTAX"'
      CurrentAction2=
     *  'at line 1012 in the TAB file'
      CurrentIGNO=256
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DFTAX"',
     *  'at line 1012 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00053(I00001,I00004,I00002)=C00025(I00001,I00004,I00002)-
     *  C00030(I00001,I00004,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "DFTAX"',
     *  'at line 1012 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00024,C00025,C00054,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00025(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "DFCTAX"'
      CurrentAction2=
     *  'at line 1017 in the TAB file'
      CurrentIGNO=258
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DFCTAX"',
     *  'at line 1017 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00054(I00001,I00004,I00002)=C00024(I00001,I00004,I00002)-
     *  C00025(I00001,I00004,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "DFCTAX"',
     *  'at line 1017 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00027,C00029,C00055,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00027(SSZ(2),SSZ(7),SSZ(1))
      REAL C00029(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "IFTAX"'
      CurrentAction2=
     *  'at line 1022 in the TAB file'
      CurrentIGNO=260
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IFTAX"',
     *  'at line 1022 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00055(I00001,I00004,I00002)=C00027(I00001,I00004,I00002)-
     *  C00029(I00001,I00004,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "IFTAX"',
     *  'at line 1022 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00026,C00027,C00056,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00027(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "IFCTAX"'
      CurrentAction2=
     *  'at line 1027 in the TAB file'
      CurrentIGNO=262
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IFCTAX"',
     *  'at line 1027 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00056(I00001,I00004,I00002)=C00026(I00001,I00004,I00002)-
     *  C00027(I00001,I00004,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "IFCTAX"',
     *  'at line 1027 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00053,C00055,C00057,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00057(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TIU"'
      CurrentAction2=
     *  'at line 1032 in the TAB file'
      CurrentIGNO=264
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TIU"',
     *  'at line 1032 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00053(I00001,I00004,I00002)+C00055(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    2 CONTINUE  ! END SUM(j,PROD_COMM
      C00057(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TIU"',
     *  'at line 1032 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00017,C00018,C00058,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00017(SSZ(2),SSZ(1))
      REAL C00018(SSZ(2),SSZ(1))
      REAL C00058(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "DPTAX"'
      CurrentAction2=
     *  'at line 1043 in the TAB file'
      CurrentIGNO=266
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPTAX"',
     *  'at line 1043 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00058(I00001,I00002)=C00017(I00001,I00002)-C00018(I00001,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "DPTAX"',
     *  'at line 1043 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00016,C00017,C00059,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00017(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "DPCTAX"'
      CurrentAction2=
     *  'at line 1048 in the TAB file'
      CurrentIGNO=268
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPCTAX"',
     *  'at line 1048 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00059(I00001,I00002)=C00016(I00001,I00002)-C00017(I00001,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "DPCTAX"',
     *  'at line 1048 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00020,C00021,C00060,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00020(SSZ(2),SSZ(1))
      REAL C00021(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "IPTAX"'
      CurrentAction2=
     *  'at line 1053 in the TAB file'
      CurrentIGNO=270
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IPTAX"',
     *  'at line 1053 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00060(I00001,I00002)=C00020(I00001,I00002)-C00021(I00001,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "IPTAX"',
     *  'at line 1053 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00030')
      RETURN
      END
      SUBROUTINE M00002(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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(233).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(233).NE.'n') then
      CALL S00009(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(233),
     *  C00023,C00044,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(234).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(234).NE.'n') then
      CALL S00010(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(234),
     *  C00024,C00026,C00044,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(236).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(236).NE.'n') then
      CALL S00011(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(236),
     *  C00022,C00045,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(237).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(237).NE.'n') then
      CALL S00012(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(237),
     *  C00044,C00045,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(239).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VDM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(239).NE.'n') then
      CALL S00013(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(239),
     *  C00012,C00018,C00030,C00046,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(241).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(241).NE.'n') then
      CALL S00014(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(241),
     *  C00028,C00047,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(242).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(242).NE.'n') then
      CALL S00015(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(242),
     *  C00035,C00036,C00046,C00047,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(243).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(243).NE.'n') then
      CALL S00016(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(243),
     *  C00035,C00046,C00047,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(244).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(244).NE.'n') then
      CALL S00017(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(244),
     *  C00045,C00047,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(246).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VGAT',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(246).NE.'n') then
      CALL S00018(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(246),
     *  C00010,C00013,C00048,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(248).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GOVEXP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(248).NE.'n') then
      CALL S00019(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(248),
     *  C00048,C00049,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(250).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPAT',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(250).NE.'n') then
      CALL S00020(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(250),
     *  C00016,C00019,C00050,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(252).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PRIVEXP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(252).NE.'n') then
      CALL S00021(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(252),
     *  C00050,C00051,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(254).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INCOME',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(254).NE.'n') then
      CALL S00022(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(254),
     *  C00009,C00049,C00051,C00052,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(256).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DFTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(256).NE.'n') then
      CALL S00023(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(256),
     *  C00025,C00030,C00053,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(258).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DFCTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(258).NE.'n') then
      CALL S00024(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(258),
     *  C00024,C00025,C00054,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(260).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IFTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(260).NE.'n') then
      CALL S00025(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(260),
     *  C00027,C00029,C00055,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(262).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IFCTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(262).NE.'n') then
      CALL S00026(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(262),
     *  C00026,C00027,C00056,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(264).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TIU',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(264).NE.'n') then
      CALL S00027(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(264),
     *  C00053,C00055,C00057,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(266).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(266).NE.'n') then
      CALL S00028(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(266),
     *  C00017,C00018,C00058,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(268).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPCTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(268).NE.'n') then
      CALL S00029(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(268),
     *  C00016,C00017,C00059,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(270).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IPTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(270).NE.'n') then
      CALL S00030(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(270),
     *  C00020,C00021,C00060,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00002')
      RETURN
      END
      SUBROUTINE S00031(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00019,C00020,C00061,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00020(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "IPCTAX"'
      CurrentAction2=
     *  'at line 1057 in the TAB file'
      CurrentIGNO=272
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IPCTAX"',
     *  'at line 1057 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00061(I00001,I00002)=C00019(I00001,I00002)-C00020(I00001,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "IPCTAX"',
     *  'at line 1057 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00058,C00060,C00062,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00062(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TPC"'
      CurrentAction2=
     *  'at line 1062 in the TAB file'
      CurrentIGNO=274
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TPC"',
     *  'at line 1062 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00058(I00001,I00002)+C00060(I00001,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00062(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TPC"',
     *  'at line 1062 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00011,C00012,C00063,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00011(SSZ(2),SSZ(1))
      REAL C00012(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "DGTAX"'
      CurrentAction2=
     *  'at line 1073 in the TAB file'
      CurrentIGNO=276
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DGTAX"',
     *  'at line 1073 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00063(I00001,I00002)=C00011(I00001,I00002)-C00012(I00001,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "DGTAX"',
     *  'at line 1073 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00010,C00011,C00064,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00011(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "DGCTAX"'
      CurrentAction2=
     *  'at line 1078 in the TAB file'
      CurrentIGNO=278
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DGCTAX"',
     *  'at line 1078 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00064(I00001,I00002)=C00010(I00001,I00002)-C00011(I00001,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "DGCTAX"',
     *  'at line 1078 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00014,C00015,C00065,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00014(SSZ(2),SSZ(1))
      REAL C00015(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "IGTAX"'
      CurrentAction2=
     *  'at line 1083 in the TAB file'
      CurrentIGNO=280
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IGTAX"',
     *  'at line 1083 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00065(I00001,I00002)=C00014(I00001,I00002)-C00015(I00001,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "IGTAX"',
     *  'at line 1083 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00013,C00014,C00066,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00014(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "IGCTAX"'
      CurrentAction2=
     *  'at line 1088 in the TAB file'
      CurrentIGNO=282
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "IGCTAX"',
     *  'at line 1088 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00066(I00001,I00002)=C00013(I00001,I00002)-C00014(I00001,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "IGCTAX"',
     *  'at line 1088 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00063,C00065,C00067,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00067(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TGC"'
      CurrentAction2=
     *  'at line 1093 in the TAB file'
      CurrentIGNO=284
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TGC"',
     *  'at line 1093 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00063(I00001,I00002)+C00065(I00001,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00067(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TGC"',
     *  'at line 1093 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00028,C00044,C00068,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00028(SSZ(6),SSZ(7),SSZ(1))
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "ETAX"'
      CurrentAction2=
     *  'at line 1104 in the TAB file'
      CurrentIGNO=286
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "ETAX"',
     *  'at line 1104 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      C00068(I00001,I00004,I00002)=C00044(SSMP(SSMPST(5)-1+
     *  I00001),I00004,I00002)-C00028(I00001,I00004,I00002)
    1 CONTINUE  ! END (all,i,ENDW_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "ETAX"',
     *  'at line 1104 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00068,C00069,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00069(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TFU"'
      CurrentAction2=
     *  'at line 1108 in the TAB file'
      CurrentIGNO=288
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TFU"',
     *  'at line 1108 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=0.0
      DO 2 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      RS2=RS2+C00068(I00001,I00004,I00002)
    2 CONTINUE  ! END SUM(i,ENDW_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00069(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TFU"',
     *  'at line 1108 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00045,C00047,C00070,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "PTAX"'
      CurrentAction2=
     *  'at line 1113 in the TAB file'
      CurrentIGNO=290
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PTAX"',
     *  'at line 1113 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(9)  ! (all,i,NSAV_COMM)
      C00070(I00001,I00002)=C00047(I00001,I00002)-C00045(I00001,I00002)
    1 CONTINUE  ! END (all,i,NSAV_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "PTAX"',
     *  'at line 1113 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00070,C00071,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00071(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TOUT"'
      CurrentAction2=
     *  'at line 1117 in the TAB file'
      CurrentIGNO=292
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TOUT"',
     *  'at line 1117 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(7)  ! SUM(i,PROD_COMM
      RS1=RS1+C00070(SSMP(SSMPST(9)-1+I00001),I00002)
    2 CONTINUE  ! END SUM(i,PROD_COMM
      C00071(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TOUT"',
     *  'at line 1117 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00035,C00072,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "XTAXD"'
      CurrentAction2=
     *  'at line 1122 in the TAB file'
      CurrentIGNO=294
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XTAXD"',
     *  'at line 1122 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00072(I00001,I00002,I00003)=C00034(I00001,I00002,I00003)-
     *  C00035(I00001,I00002,I00003)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "XTAXD"',
     *  'at line 1122 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00072,C00073,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00073(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TEX"'
      CurrentAction2=
     *  'at line 1126 in the TAB file'
      CurrentIGNO=296
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TEX"',
     *  'at line 1126 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00072(I00001,I00002,I00003)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(s,REG
      C00073(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TEX"',
     *  'at line 1126 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00032,C00033,C00074,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "MTAX"'
      CurrentAction2=
     *  'at line 1131 in the TAB file'
      CurrentIGNO=298
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "MTAX"',
     *  'at line 1131 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00074(I00001,I00002,I00003)=C00032(I00001,I00002,I00003)-
     *  C00033(I00001,I00002,I00003)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "MTAX"',
     *  'at line 1131 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00074,C00075,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00075(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TIM"'
      CurrentAction2=
     *  'at line 1135 in the TAB file'
      CurrentIGNO=300
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TIM"',
     *  'at line 1135 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00074(I00001,I00003,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(s,REG
      C00075(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TIM"',
     *  'at line 1135 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00045,C00077,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00077(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "REGINV"'
      CurrentAction2=
     *  'at line 1154 in the TAB file'
      CurrentIGNO=304
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "REGINV"',
     *  'at line 1154 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00008=1,SSZ(5)  ! SUM(k,CGDS_COMM
      RS1=RS1+C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00008)),I00002)
    2 CONTINUE  ! END SUM(k,CGDS_COMM
      C00077(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "REGINV"',
     *  'at line 1154 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00031,C00045,C00078,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00078(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "NETINV"'
      CurrentAction2=
     *  'at line 1158 in the TAB file'
      CurrentIGNO=306
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "NETINV"',
     *  'at line 1158 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00008=1,SSZ(5)  ! SUM(k,CGDS_COMM
      RS1=RS1+C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00008)),I00002)
    2 CONTINUE  ! END SUM(k,CGDS_COMM
      C00078(I00002)=RS1-C00031(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "NETINV"',
     *  'at line 1158 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00078,C00079,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00079(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GLOBINV"'
      CurrentAction2=
     *  'at line 1162 in the TAB file'
      CurrentIGNO=308
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GLOBINV"',
     *  'at line 1162 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      RS1=0.0
      DO 1 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00078(I00002)
    1 CONTINUE  ! END SUM(r,REG
      C00079(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GLOBINV"',
     *  'at line 1162 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00037,C00038,C00039,C00040,C00041,C00042,C00081,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00037(SSZ(2),SSZ(7),SSZ(1))
      REAL C00038(SSZ(2),SSZ(7),SSZ(1))
      REAL C00039(SSZ(2),SSZ(1))
      REAL C00040(SSZ(2),SSZ(1))
      REAL C00041(SSZ(2),SSZ(1))
      REAL C00042(SSZ(2),SSZ(1))
      REAL C00081(SSZ(1),SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "CO2"'
      CurrentAction2=
     *  'at line 1172 in the TAB file'
      CurrentIGNO=311
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2"',
     *  'at line 1172 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00037(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      RS2=0.0
      DO 4 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=RS2+C00038(I00001,I00004,I00002)
    4 CONTINUE  ! END SUM(j,PROD_COMM
      C00081(I00002,I00001)=RS1+RS2+C00039(I00001,I00002)+
     *  C00040(I00001,I00002)+C00041(I00001,I00002)+
     *  C00042(I00001,I00002)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "CO2"',
     *  'at line 1172 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00081,C00082,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00081(SSZ(1),SSZ(2))
      REAL C00082(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "CO2T"'
      CurrentAction2=
     *  'at line 1178 in the TAB file'
      CurrentIGNO=313
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2T"',
     *  'at line 1178 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(14)  ! SUM(i,CTAX_COMM
      RS1=RS1+C00081(I00002,SSMP(SSMPST(14)-1+I00001))
    2 CONTINUE  ! END SUM(i,CTAX_COMM
      C00082(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "CO2T"',
     *  'at line 1178 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00008,C00082,C00083,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00006
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00082(SSZ(1))
      REAL C00083(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "CO2TB"'
      CurrentAction2=
     *  'at line 1183 in the TAB file'
      CurrentIGNO=315
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2TB"',
     *  'at line 1183 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00006=1,SSZ(17)  ! (all,b,BLOC)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)  ! SUM(r,REG:
      LG1=C00008(I00002).EQ.I00006
      IF(LG1) THEN
      RS1=RS1+C00082(I00002)
      END IF ! IF(LG1) THEN
    2 CONTINUE  ! END SUM(r,REG
      C00083(I00006)=RS1
    1 CONTINUE  ! END (all,b,BLOC)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "CO2TB"',
     *  'at line 1183 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00010,C00011,C00086,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00011(SSZ(2),SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHVDGANC"'
      CurrentAction2=
     *  'at line 1257 in the TAB file'
      CurrentIGNO=328
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVDGANC"',
     *  'at line 1257 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00011(I00001,I00002)
      RS2=C00010(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00086(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHVDGANC"',
     *  'at line 1257 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00010,C00039,C00087,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00039(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "CO2DGVDGA"'
      CurrentAction2=
     *  'at line 1265 in the TAB file'
      CurrentIGNO=332
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2DGVDGA"',
     *  'at line 1265 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00039(I00001,I00002)
      RS2=C00010(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00087(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "CO2DGVDGA"',
     *  'at line 1265 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00013,C00014,C00088,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00014(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHVIGANC"'
      CurrentAction2=
     *  'at line 1279 in the TAB file'
      CurrentIGNO=337
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVIGANC"',
     *  'at line 1279 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00014(I00001,I00002)
      RS2=C00013(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00088(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHVIGANC"',
     *  'at line 1279 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00054')
      RETURN
      END
      SUBROUTINE S00055(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00013,C00040,C00089,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00040(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "CO2IGVIGA"'
      CurrentAction2=
     *  'at line 1287 in the TAB file'
      CurrentIGNO=341
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2IGVIGA"',
     *  'at line 1287 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00040(I00001,I00002)
      RS2=C00013(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00089(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "CO2IGVIGA"',
     *  'at line 1287 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00013,C00048,C00090,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GMSHR"'
      CurrentAction2=
     *  'at line 1299 in the TAB file'
      CurrentIGNO=345
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GMSHR"',
     *  'at line 1299 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00013(I00001,I00003)
      RS2=C00048(I00001,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='s           '
         ErrorIndVal(2)=I00003
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00090(I00001,I00003)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GMSHR"',
     *  'at line 1299 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00048,C00084,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00084(SSZ(19),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VGA"'
      CurrentAction2=
     *  'at line 1332 in the TAB file'
      CurrentIGNO=350
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VGA"',
     *  'at line 1332 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00084(SSMP(SSMPST(17)-1+I00001),I00002)=C00048(I00001,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VGA"',
     *  'at line 1332 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00084,C00085,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00084(SSZ(19),SSZ(1))
      REAL C00085(SSZ(18),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VGAS"'
      CurrentAction2=
     *  'at line 1358 in the TAB file'
      CurrentIGNO=358
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VGAS"',
     *  'at line 1358 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(21)  ! SUM(i,ENY_GCOMM
      RS1=RS1+C00084(SSMP(SSMPST(17)-1+SSMP(SSMPST(21)-1+
     *  I00001)),I00002)
    2 CONTINUE  ! END SUM(i,ENY_GCOMM
      C00085(1,I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VGAS"',
     *  'at line 1358 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00084,C00085,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00084(SSZ(19),SSZ(1))
      REAL C00085(SSZ(18),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VGA"'
      CurrentAction2=
     *  'at line 1360 in the TAB file'
      CurrentIGNO=361
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VGA"',
     *  'at line 1360 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00084(SSMP(SSMPST(22)-1+1),I00002)=C00085(1,I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VGA"',
     *  'at line 1360 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00091,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00091(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GSIZE_ENY"'
      CurrentAction2=
     *  'at line 1365 in the TAB file'
      CurrentIGNO=363
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GSIZE_ENY"',
     *  'at line 1365 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(21)  ! SUM(i,ENY_GCOMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,ENY_GCOMM
      C00091(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GSIZE_ENY"',
     *  'at line 1365 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00085,C00091,C00092,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00085(SSZ(18),SSZ(1))
      REAL C00091(1)
      REAL C00092(SSZ(21),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GSHENY"'
      CurrentAction2=
     *  'at line 1370 in the TAB file'
      CurrentIGNO=365
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GSHENY"',
     *  'at line 1370 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 1 I00001=1,SSZ(21)  ! (all,i,ENY_GCOMM)
      LG1=C00085(1,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00091(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=21
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00092(I00001,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,ENY_GCOMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GSHENY"',
     *  'at line 1370 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00084,C00085,C00092,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00084(SSZ(19),SSZ(1))
      REAL C00085(SSZ(18),SSZ(1))
      REAL C00092(SSZ(21),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GSHENY"'
      CurrentAction2=
     *  'at line 1372 in the TAB file'
      CurrentIGNO=366
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GSHENY"',
     *  'at line 1372 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 1 I00001=1,SSZ(21)  ! (all,i,ENY_GCOMM)
      LG1=C00085(1,I00002).GT.0
      IF(LG1) THEN
      RS1=C00084(SSMP(SSMPST(17)-1+SSMP(SSMPST(21)-1+I00001)),I00002)
      RS2=C00085(1,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=21
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00092(I00001,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,ENY_GCOMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GSHENY"',
     *  'at line 1372 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00084,C00085,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00084(SSZ(19),SSZ(1))
      REAL C00085(SSZ(18),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VGAS"'
      CurrentAction2=
     *  'at line 1397 in the TAB file'
      CurrentIGNO=373
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VGAS"',
     *  'at line 1397 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(23)  ! SUM(i,NENY_GCOMM
      RS1=RS1+C00084(SSMP(SSMPST(17)-1+SSMP(SSMPST(23)-1+
     *  I00001)),I00002)
    2 CONTINUE  ! END SUM(i,NENY_GCOMM
      C00085(2,I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VGAS"',
     *  'at line 1397 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00063')
      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(272).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IPCTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(272).NE.'n') then
      CALL S00031(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(272),
     *  C00019,C00020,C00061,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(274).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TPC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(274).NE.'n') then
      CALL S00032(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(274),
     *  C00058,C00060,C00062,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(276).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DGTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(276).NE.'n') then
      CALL S00033(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(276),
     *  C00011,C00012,C00063,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(278).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DGCTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(278).NE.'n') then
      CALL S00034(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(278),
     *  C00010,C00011,C00064,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(280).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IGTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(280).NE.'n') then
      CALL S00035(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(280),
     *  C00014,C00015,C00065,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(282).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'IGCTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(282).NE.'n') then
      CALL S00036(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(282),
     *  C00013,C00014,C00066,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(284).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TGC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(284).NE.'n') then
      CALL S00037(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(284),
     *  C00063,C00065,C00067,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(286).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'ETAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(286).NE.'n') then
      CALL S00038(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(286),
     *  C00028,C00044,C00068,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(288).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TFU',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(288).NE.'n') then
      CALL S00039(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(288),
     *  C00068,C00069,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(290).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(290).NE.'n') then
      CALL S00040(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(290),
     *  C00045,C00047,C00070,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(292).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TOUT',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(292).NE.'n') then
      CALL S00041(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(292),
     *  C00070,C00071,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(294).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XTAXD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(294).NE.'n') then
      CALL S00042(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(294),
     *  C00034,C00035,C00072,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(296).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TEX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(296).NE.'n') then
      CALL S00043(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(296),
     *  C00072,C00073,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(298).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'MTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(298).NE.'n') then
      CALL S00044(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(298),
     *  C00032,C00033,C00074,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(300).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TIM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(300).NE.'n') then
      CALL S00045(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(300),
     *  C00074,C00075,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(304).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'REGINV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(304).NE.'n') then
      CALL S00046(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(304),
     *  C00045,C00077,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(306).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NETINV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(306).NE.'n') then
      CALL S00047(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(306),
     *  C00031,C00045,C00078,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(308).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GLOBINV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(308).NE.'n') then
      CALL S00048(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(308),
     *  C00078,C00079,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(311).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(311).NE.'n') then
      CALL S00049(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(311),
     *  C00037,C00038,C00039,C00040,C00041,C00042,C00081,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(313).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2T',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(313).NE.'n') then
      CALL S00050(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(313),
     *  C00081,C00082,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(FSTPAS.OR.PRELIM)THEN
      CALL TGCHMR(FSTPAS.OR.PRELIM,'REGTOBLOC   ',1,17,
     *  MMNST,SSZ,SSZ(1),C00008,1,
     *  '?','REG         ','BLOC        ',
     *  MMEL,STEL,ELAD(17)-1,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(PRELIM.OR.FSTPAS) THEN
       CALL TGRSMV(8,1,MMNST,SSZ,
     *   MMNCS,SMVLST,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(ECHO1.AND.DOIG(315).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2TB',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(315).NE.'n') then
      CALL S00051(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(315),
     *  C00008,C00082,C00083,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(85,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(84,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=2
       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=18
       SSNO=18
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,18,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(328).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVDGANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(328).NE.'n') then
      CALL S00052(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(328),
     *  C00010,C00011,C00086,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(332).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2DGVDGA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(332).NE.'n') then
      CALL S00053(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(332),
     *  C00010,C00039,C00087,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(337).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVIGANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(337).NE.'n') then
      CALL S00054(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(337),
     *  C00013,C00014,C00088,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(341).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2IGVIGA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(341).NE.'n') then
      CALL S00055(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(341),
     *  C00013,C00040,C00089,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(345).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GMSHR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(345).NE.'n') then
      CALL S00056(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(345),
     *  C00013,C00048,C00090,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(350).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VGA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(350).NE.'n') then
      CALL S00057(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(350),
     *  C00048,C00084,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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
      IF(PRELIM) THEN
       CALL SSAL1C(92,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=20
       SSNO=19
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,19,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=16
       SSNO=20
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,20,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=21
       SSNO=21
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,21,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(358).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VGAS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(358).NE.'n') then
      CALL S00058(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(358),
     *  C00084,C00085,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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=22
       SSNO=22
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,22,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(361).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VGA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(361).NE.'n') then
      CALL S00059(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(361),
     *  C00084,C00085,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(363).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GSIZE_ENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(363).NE.'n') then
      CALL S00060(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(363),
     *  C00091,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(365).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GSHENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(365).NE.'n') then
      CALL S00061(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(365),
     *  C00085,C00091,C00092,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(366).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GSHENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(366).NE.'n') then
      CALL S00062(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(366),
     *  C00084,C00085,C00092,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(95,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=23
       SSNO=23
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,23,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.DOIG(373).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VGAS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(373).NE.'n') then
      CALL S00063(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(373),
     *  C00084,C00085,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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=24
       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('M00003')
      RETURN
      END
      SUBROUTINE S00064(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00084,C00085,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00084(SSZ(19),SSZ(1))
      REAL C00085(SSZ(18),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VGA"'
      CurrentAction2=
     *  'at line 1399 in the TAB file'
      CurrentIGNO=376
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VGA"',
     *  'at line 1399 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00084(SSMP(SSMPST(24)-1+1),I00002)=C00085(2,I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VGA"',
     *  'at line 1399 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00094,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00094(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GSIZE_NENY"'
      CurrentAction2=
     *  'at line 1404 in the TAB file'
      CurrentIGNO=378
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GSIZE_NENY"',
     *  'at line 1404 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(23)  ! SUM(i,NENY_GCOMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,NENY_GCOMM
      C00094(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GSIZE_NENY"',
     *  'at line 1404 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00085,C00094,C00095,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00085(SSZ(18),SSZ(1))
      REAL C00094(1)
      REAL C00095(SSZ(23),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GSHNENY"'
      CurrentAction2=
     *  'at line 1410 in the TAB file'
      CurrentIGNO=380
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GSHNENY"',
     *  'at line 1410 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 1 I00001=1,SSZ(23)  ! (all,i,NENY_GCOMM)
      LG1=C00085(2,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00094(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=23
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00095(I00001,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,NENY_GCOMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GSHNENY"',
     *  'at line 1410 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00084,C00085,C00095,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00084(SSZ(19),SSZ(1))
      REAL C00085(SSZ(18),SSZ(1))
      REAL C00095(SSZ(23),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GSHNENY"'
      CurrentAction2=
     *  'at line 1412 in the TAB file'
      CurrentIGNO=381
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GSHNENY"',
     *  'at line 1412 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 1 I00001=1,SSZ(23)  ! (all,i,NENY_GCOMM)
      LG1=C00085(2,I00002).GT.0
      IF(LG1) THEN
      RS1=C00084(SSMP(SSMPST(17)-1+SSMP(SSMPST(23)-1+I00001)),I00002)
      RS2=C00085(2,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=23
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00095(I00001,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,NENY_GCOMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GSHNENY"',
     *  'at line 1412 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00016,C00017,C00100,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00017(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHVDPANC"'
      CurrentAction2=
     *  'at line 1530 in the TAB file'
      CurrentIGNO=408
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVDPANC"',
     *  'at line 1530 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00017(I00001,I00002)
      RS2=C00016(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00100(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHVDPANC"',
     *  'at line 1530 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00016,C00041,C00101,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00041(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "CO2DPVDPA"'
      CurrentAction2=
     *  'at line 1538 in the TAB file'
      CurrentIGNO=412
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2DPVDPA"',
     *  'at line 1538 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00041(I00001,I00002)
      RS2=C00016(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00101(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "CO2DPVDPA"',
     *  'at line 1538 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00019,C00020,C00102,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00020(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHVIPANC"'
      CurrentAction2=
     *  'at line 1559 in the TAB file'
      CurrentIGNO=419
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVIPANC"',
     *  'at line 1559 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00020(I00001,I00002)
      RS2=C00019(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00102(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHVIPANC"',
     *  'at line 1559 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00019,C00042,C00103,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00042(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "CO2IPVIPA"'
      CurrentAction2=
     *  'at line 1567 in the TAB file'
      CurrentIGNO=423
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2IPVIPA"',
     *  'at line 1567 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00042(I00001,I00002)
      RS2=C00019(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00103(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "CO2IPVIPA"',
     *  'at line 1567 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00019,C00050,C00104,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "PMSHR"'
      CurrentAction2=
     *  'at line 1588 in the TAB file'
      CurrentIGNO=428
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PMSHR"',
     *  'at line 1588 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00019(I00001,I00003)
      RS2=C00050(I00001,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='s           '
         ErrorIndVal(2)=I00003
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00104(I00001,I00003)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "PMSHR"',
     *  'at line 1588 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00050,C00098,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00098(SSZ(27),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VPA"'
      CurrentAction2=
     *  'at line 1612 in the TAB file'
      CurrentIGNO=432
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPA"',
     *  'at line 1612 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00098(SSMP(SSMPST(26)-1+I00001),I00002)=C00050(I00001,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VPA"',
     *  'at line 1612 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00098,C00099,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00098(SSZ(27),SSZ(1))
      REAL C00099(SSZ(26),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VPAS"'
      CurrentAction2=
     *  'at line 1638 in the TAB file'
      CurrentIGNO=440
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPAS"',
     *  'at line 1638 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(29)  ! SUM(i,ENY_PCOMM
      RS1=RS1+C00098(SSMP(SSMPST(26)-1+SSMP(SSMPST(30)-1+
     *  I00001)),I00002)
    2 CONTINUE  ! END SUM(i,ENY_PCOMM
      C00099(1,I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VPAS"',
     *  'at line 1638 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00098,C00099,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00098(SSZ(27),SSZ(1))
      REAL C00099(SSZ(26),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VPA"'
      CurrentAction2=
     *  'at line 1640 in the TAB file'
      CurrentIGNO=441
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPA"',
     *  'at line 1640 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00098(SSMP(SSMPST(27)-1+1),I00002)=C00099(1,I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VPA"',
     *  'at line 1640 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00105,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00105(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "PSIZE_ENY"'
      CurrentAction2=
     *  'at line 1645 in the TAB file'
      CurrentIGNO=443
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PSIZE_ENY"',
     *  'at line 1645 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(29)  ! SUM(i,ENY_PCOMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,ENY_PCOMM
      C00105(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "PSIZE_ENY"',
     *  'at line 1645 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00099,C00105,C00106,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00099(SSZ(26),SSZ(1))
      REAL C00105(1)
      REAL C00106(SSZ(29),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "PSHENY"'
      CurrentAction2=
     *  'at line 1650 in the TAB file'
      CurrentIGNO=445
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PSHENY"',
     *  'at line 1650 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 1 I00001=1,SSZ(29)  ! (all,i,ENY_PCOMM)
      LG1=C00099(1,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00105(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=29
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00106(I00001,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,ENY_PCOMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "PSHENY"',
     *  'at line 1650 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00098,C00099,C00106,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00098(SSZ(27),SSZ(1))
      REAL C00099(SSZ(26),SSZ(1))
      REAL C00106(SSZ(29),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "PSHENY"'
      CurrentAction2=
     *  'at line 1652 in the TAB file'
      CurrentIGNO=446
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PSHENY"',
     *  'at line 1652 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 1 I00001=1,SSZ(29)  ! (all,i,ENY_PCOMM)
      LG1=C00099(1,I00002).GT.0
      IF(LG1) THEN
      RS1=C00098(SSMP(SSMPST(26)-1+SSMP(SSMPST(30)-1+I00001)),I00002)
      RS2=C00099(1,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=29
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00106(I00001,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,ENY_PCOMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "PSHENY"',
     *  'at line 1652 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00098,C00110,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00098(SSZ(27),SSZ(1))
      REAL C00110(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "PSHUP"'
      CurrentAction2=
     *  'at line 1700 in the TAB file'
      CurrentIGNO=463
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PSHUP"',
     *  'at line 1700 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(32)  ! SUM(k,UP_COMM
      RS1=RS1+C00098(SSMP(SSMPST(34)-1+I00008),I00002)
    3 CONTINUE  ! END SUM(k,UP_COMM
      RS2=C00098(SSMP(SSMPST(34)-1+I00001),I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=32
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00110(I00001,I00002)=RS4
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "PSHUP"',
     *  'at line 1700 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00080,C00108,C00110,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00080(SSZ(1))
      REAL C00108(SSZ(32),SSZ(1))
      REAL C00110(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "UELASPRIV"'
      CurrentAction2=
     *  'at line 1703 in the TAB file'
      CurrentIGNO=464
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UELASPRIV"',
     *  'at line 1703 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(32)  ! SUM(i,UP_COMM
      RS1=RS1+C00110(I00001,I00002)*C00108(I00001,I00002)
    2 CONTINUE  ! END SUM(i,UP_COMM
      C00080(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "UELASPRIV"',
     *  'at line 1703 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00109,C00111,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00109(SSZ(32),SSZ(1))
      REAL C00111(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "ALPHA"'
      CurrentAction2=
     *  'at line 1711 in the TAB file'
      CurrentIGNO=466
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "ALPHA"',
     *  'at line 1711 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      C00111(I00001,I00002)=1  -C00109(I00001,I00002)
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "ALPHA"',
     *  'at line 1711 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00110,C00111,C00112,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER I00009
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00110(SSZ(32),SSZ(1))
      REAL C00111(SSZ(32),SSZ(1))
      REAL C00112(SSZ(32),SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "APE"'
      CurrentAction2=
     *  'at line 1716 in the TAB file'
      CurrentIGNO=468
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "APE"',
     *  'at line 1716 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00008=1,SSZ(32)  ! (all,k,UP_COMM)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RS1=0.0
      DO 4 I00009=1,SSZ(32)  ! SUM(n,UP_COMM
      RS1=RS1+C00110(I00009,I00002)*C00111(I00009,I00002)
    4 CONTINUE  ! END SUM(n,UP_COMM
      C00112(I00001,I00008,I00002)=C00111(I00001,I00002)+
     *  C00111(I00008,I00002)-RS1
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,k,UP_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "APE"',
     *  'at line 1716 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00110,C00111,C00112,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00009
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00110(SSZ(32),SSZ(1))
      REAL C00111(SSZ(32),SSZ(1))
      REAL C00112(SSZ(32),SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "APE"'
      CurrentAction2=
     *  'at line 1719 in the TAB file'
      CurrentIGNO=469
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "APE"',
     *  'at line 1719 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RS1=0.0
      DO 3 I00009=1,SSZ(32)  ! SUM(n,UP_COMM
      RS1=RS1+C00110(I00009,I00002)*C00111(I00009,I00002)
    3 CONTINUE  ! END SUM(n,UP_COMM
      RS2=C00111(I00001,I00002)
      RS3=C00110(I00001,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=32
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00112(I00001,I00001,I00002)=2.0*C00111(I00001,I00002)-RS1-RS4
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "APE"',
     *  'at line 1719 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00108,C00110,C00111,C00113,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00009
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00108(SSZ(32),SSZ(1))
      REAL C00110(SSZ(32),SSZ(1))
      REAL C00111(SSZ(32),SSZ(1))
      REAL C00113(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "EY"'
      CurrentAction2=
     *  'at line 1727 in the TAB file'
      CurrentIGNO=471
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EY"',
     *  'at line 1727 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RS1=0.0
      DO 3 I00009=1,SSZ(32)  ! SUM(n,UP_COMM
      RS1=RS1+C00110(I00009,I00002)*C00108(I00009,I00002)
    3 CONTINUE  ! END SUM(n,UP_COMM
      RS2=1.0
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=32
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      RS5=0.0
      DO 4 I00009=1,SSZ(32)  ! SUM(n,UP_COMM
      RS5=RS5+C00110(I00009,I00002)*C00108(I00009,I00002)*
     *  C00111(I00009,I00002)
    4 CONTINUE  ! END SUM(n,UP_COMM
      RS6=0.0
      DO 5 I00009=1,SSZ(32)  ! SUM(n,UP_COMM
      RS6=RS6+C00110(I00009,I00002)*C00111(I00009,I00002)
    5 CONTINUE  ! END SUM(n,UP_COMM
      C00113(I00001,I00002)=RS4*(C00108(I00001,I00002)*(1.0-
     *  C00111(I00001,I00002))+RS5)+C00111(I00001,I00002)-RS6
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "EY"',
     *  'at line 1727 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00114,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00114(SSZ(32),SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "EP"'
      CurrentAction2=
     *  'at line 1737 in the TAB file'
      CurrentIGNO=473
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EP"',
     *  'at line 1737 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00008=1,SSZ(32)  ! (all,k,UP_COMM)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      C00114(I00001,I00008,I00002)=0
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,k,UP_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "EP"',
     *  'at line 1737 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00110,C00112,C00113,C00114,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00110(SSZ(32),SSZ(1))
      REAL C00112(SSZ(32),SSZ(32),SSZ(1))
      REAL C00113(SSZ(32),SSZ(1))
      REAL C00114(SSZ(32),SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "EP"'
      CurrentAction2=
     *  'at line 1739 in the TAB file'
      CurrentIGNO=474
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EP"',
     *  'at line 1739 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00008=1,SSZ(32)  ! (all,k,UP_COMM)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      C00114(I00001,I00008,I00002)=(C00112(I00001,I00008,I00002)-
     *  C00113(I00001,I00002))*C00110(I00008,I00002)
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,k,UP_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "EP"',
     *  'at line 1739 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00080,C00108,C00110,C00115,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00080(SSZ(1))
      REAL C00108(SSZ(32),SSZ(1))
      REAL C00110(SSZ(32),SSZ(1))
      REAL C00115(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "XWCONSHR"'
      CurrentAction2=
     *  'at line 1771 in the TAB file'
      CurrentIGNO=479
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XWCONSHR"',
     *  'at line 1771 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RS1=C00110(I00001,I00002)*C00108(I00001,I00002)
      RS2=C00080(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=32
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00115(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "XWCONSHR"',
     *  'at line 1771 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00087')
      RETURN
      END
      SUBROUTINE M00004(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(ECHO1.AND.DOIG(376).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VGA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(376).NE.'n') then
      CALL S00064(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(376),
     *  C00084,C00085,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(378).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GSIZE_NENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(378).NE.'n') then
      CALL S00065(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(378),
     *  C00094,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(380).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GSHNENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(380).NE.'n') then
      CALL S00066(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(380),
     *  C00085,C00094,C00095,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(381).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GSHNENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(381).NE.'n') then
      CALL S00067(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(381),
     *  C00084,C00085,C00095,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=25
       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
      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(99,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(98,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=2
       SSNO=26
       IF((PRELIM.AND.SSPOSTSIM(SSNO).EQ.'n').OR.
     *     (POSTSIMPASS2.AND.SSPOSTSIM(SSNO).EQ.'y')) THEN
        IF(SSMPST(SSNO).LE.0) THEN
         SSMPST(SSNO)=NSSMP+1
         NSSMP=NSSMP+SSZ(LITSN)
         CALL TGINCP(NSSMP+MAX(1,SSZ(LITSN))-SSZ(LITSN),
     *     DSSMP,'DSSMP',ERRMES)
         IF(ERRMES(1:1).EQ.'E') GOTO 15000
        END IF
       END IF
      END IF
      CALL TGNISS('tg',AXSUN,26,DSSMP,SSMP,
     *  MMNST,STNM,SSZ,SZUB,ELAD,MMEL,STEL,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,MMNSS,SSMPST,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=26
       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
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(408).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVDPANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(408).NE.'n') then
      CALL S00068(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(408),
     *  C00016,C00017,C00100,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(412).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2DPVDPA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(412).NE.'n') then
      CALL S00069(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(412),
     *  C00016,C00041,C00101,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(419).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVIPANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(419).NE.'n') then
      CALL S00070(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(419),
     *  C00019,C00020,C00102,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(423).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2IPVIPA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(423).NE.'n') then
      CALL S00071(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(423),
     *  C00019,C00042,C00103,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(428).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PMSHR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(428).NE.'n') then
      CALL S00072(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(428),
     *  C00019,C00050,C00104,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(432).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(432).NE.'n') then
      CALL S00073(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(432),
     *  C00050,C00098,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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
      IF(PRELIM) THEN
       CALL SSAL1C(106,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=28
       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=16
       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
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=29
       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(440).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPAS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(440).NE.'n') then
      CALL S00074(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(440),
     *  C00098,C00099,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(441).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(441).NE.'n') then
      CALL S00075(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(441),
     *  C00098,C00099,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(443).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PSIZE_ENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(443).NE.'n') then
      CALL S00076(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(443),
     *  C00105,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(445).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PSHENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(445).NE.'n') then
      CALL S00077(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(445),
     *  C00099,C00105,C00106,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(446).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PSHENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(446).NE.'n') then
      CALL S00078(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(446),
     *  C00098,C00099,C00106,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=30
       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
      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(108,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(110,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(113,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(115,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(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(235,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=31
       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(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=30
       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(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=32
       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
      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(463).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PSHUP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(463).NE.'n') then
      CALL S00079(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(463),
     *  C00098,C00110,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(464).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UELASPRIV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(464).NE.'n') then
      CALL S00080(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(464),
     *  C00080,C00108,C00110,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(466).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'ALPHA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(466).NE.'n') then
      CALL S00081(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(466),
     *  C00109,C00111,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(468).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'APE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(468).NE.'n') then
      CALL S00082(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(468),
     *  C00110,C00111,C00112,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(469).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'APE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(469).NE.'n') then
      CALL S00083(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(469),
     *  C00110,C00111,C00112,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(471).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(471).NE.'n') then
      CALL S00084(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(471),
     *  C00108,C00110,C00111,C00113,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(473).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(473).NE.'n') then
      CALL S00085(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(473),
     *  C00114,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(474).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(474).NE.'n') then
      CALL S00086(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(474),
     *  C00110,C00112,C00113,C00114,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(479).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XWCONSHR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(479).NE.'n') then
      CALL S00087(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(479),
     *  C00080,C00108,C00110,C00115,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(117,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(118,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(116,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(313,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM) THEN
       CALL SSAL1C(316,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RETURN
15000 CALL PERET('M00004')
      RETURN
      END
      SUBROUTINE S00088(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00024,C00025,C00119,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00025(SSZ(2),SSZ(7),SSZ(1))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHVDFANC"'
      CurrentAction2=
     *  'at line 1956 in the TAB file'
      CurrentIGNO=502
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVDFANC"',
     *  'at line 1956 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00025(I00001,I00004,I00002)
      RS2=C00024(I00001,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00119(I00001,I00004,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHVDFANC"',
     *  'at line 1956 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00024,C00037,C00120,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00037(SSZ(2),SSZ(7),SSZ(1))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "CO2DFVDFA"'
      CurrentAction2=
     *  'at line 1964 in the TAB file'
      CurrentIGNO=506
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2DFVDFA"',
     *  'at line 1964 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00037(I00001,I00004,I00002)
      RS2=C00024(I00001,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00120(I00001,I00004,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "CO2DFVDFA"',
     *  'at line 1964 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00089')
      RETURN
      END
      SUBROUTINE S00090(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00026,C00027,C00121,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00027(SSZ(2),SSZ(7),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHVIFANC"'
      CurrentAction2=
     *  'at line 1978 in the TAB file'
      CurrentIGNO=511
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHVIFANC"',
     *  'at line 1978 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00027(I00001,I00004,I00002)
      RS2=C00026(I00001,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00121(I00001,I00004,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHVIFANC"',
     *  'at line 1978 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00026,C00038,C00122,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00038(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "CO2IFVIFA"'
      CurrentAction2=
     *  'at line 1986 in the TAB file'
      CurrentIGNO=515
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2IFVIFA"',
     *  'at line 1986 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00038(I00001,I00004,I00002)
      RS2=C00026(I00001,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE IF(RS1.EQ.0.0) THEN
        RS3=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00122(I00001,I00004,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "CO2IFVIFA"',
     *  'at line 1986 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00026,C00044,C00123,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FMSHR"'
      CurrentAction2=
     *  'at line 2009 in the TAB file'
      CurrentIGNO=520
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FMSHR"',
     *  'at line 2009 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00026(I00001,I00004,I00003)
      RS2=C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='s           '
         ErrorIndVal(3)=I00003
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00123(I00001,I00004,I00003)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FMSHR"',
     *  'at line 2009 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00044,C00116,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFA"'
      CurrentAction2=
     *  'at line 2032 in the TAB file'
      CurrentIGNO=524
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  'at line 2032 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(8)  ! (all,i,DEMD_COMM)
      C00116(SSMP(SSMPST(35)-1+I00001),I00004,I00002)=
     *  C00044(I00001,I00004,I00002)
    1 CONTINUE  ! END (all,i,DEMD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFA"',
     *  'at line 2032 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFAS"'
      CurrentAction2=
     *  'at line 2083 in the TAB file'
      CurrentIGNO=536
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAS"',
     *  'at line 2083 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(36)  ! SUM(i,NCOAL_FCOMM
      RS1=RS1+C00116(SSMP(SSMPST(38)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(i,NCOAL_FCOMM
      C00117(5,I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFAS"',
     *  'at line 2083 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFA"'
      CurrentAction2=
     *  'at line 2085 in the TAB file'
      CurrentIGNO=539
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  'at line 2085 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      C00116(SSMP(SSMPST(39)-1+1),I00004,I00002)=C00117(5,I00004,I00002)
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFA"',
     *  'at line 2085 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00124,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00124(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSIZE_NCOAL"'
      CurrentAction2=
     *  'at line 2090 in the TAB file'
      CurrentIGNO=541
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSIZE_NCOAL"',
     *  'at line 2090 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(36)  ! SUM(i,NCOAL_FCOMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,NCOAL_FCOMM
      C00124(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSIZE_NCOAL"',
     *  'at line 2090 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00117,C00124,C00125,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      REAL C00124(1)
      REAL C00125(SSZ(36),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHNCOAL"'
      CurrentAction2=
     *  'at line 2096 in the TAB file'
      CurrentIGNO=543
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHNCOAL"',
     *  'at line 2096 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(36)  ! (all,i,NCOAL_FCOMM)
      LG1=C00117(5,I00004,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00124(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=36
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00125(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,NCOAL_FCOMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHNCOAL"',
     *  'at line 2096 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,C00125,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      REAL C00125(SSZ(36),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHNCOAL"'
      CurrentAction2=
     *  'at line 2098 in the TAB file'
      CurrentIGNO=544
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHNCOAL"',
     *  'at line 2098 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(36)  ! (all,i,NCOAL_FCOMM)
      LG1=C00117(5,I00004,I00002).GT.0
      IF(LG1) THEN
      RS1=C00116(SSMP(SSMPST(38)-1+I00001),I00004,I00002)
      RS2=C00117(5,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=36
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00125(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,NCOAL_FCOMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHNCOAL"',
     *  'at line 2098 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFAS"'
      CurrentAction2=
     *  'at line 2130 in the TAB file'
      CurrentIGNO=551
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAS"',
     *  'at line 2130 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(38)  ! SUM(i,NELY_FCOMM
      RS1=RS1+C00116(SSMP(SSMPST(40)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(i,NELY_FCOMM
      C00117(4,I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFAS"',
     *  'at line 2130 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFA"'
      CurrentAction2=
     *  'at line 2132 in the TAB file'
      CurrentIGNO=554
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  'at line 2132 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      C00116(SSMP(SSMPST(41)-1+1),I00004,I00002)=C00117(4,I00004,I00002)
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFA"',
     *  'at line 2132 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00127,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00127(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSIZE_NELY"'
      CurrentAction2=
     *  'at line 2137 in the TAB file'
      CurrentIGNO=556
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSIZE_NELY"',
     *  'at line 2137 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(38)  ! SUM(i,NELY_FCOMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,NELY_FCOMM
      C00127(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSIZE_NELY"',
     *  'at line 2137 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00117,C00127,C00128,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      REAL C00127(1)
      REAL C00128(SSZ(38),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHNELY"'
      CurrentAction2=
     *  'at line 2143 in the TAB file'
      CurrentIGNO=558
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHNELY"',
     *  'at line 2143 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(38)  ! (all,i,NELY_FCOMM)
      LG1=C00117(4,I00004,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00127(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=38
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00128(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,NELY_FCOMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHNELY"',
     *  'at line 2143 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,C00128,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      REAL C00128(SSZ(38),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHNELY"'
      CurrentAction2=
     *  'at line 2145 in the TAB file'
      CurrentIGNO=559
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHNELY"',
     *  'at line 2145 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(38)  ! (all,i,NELY_FCOMM)
      LG1=C00117(4,I00004,I00002).GT.0
      IF(LG1) THEN
      RS1=C00116(SSMP(SSMPST(40)-1+I00001),I00004,I00002)
      RS2=C00117(4,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=38
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00128(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,NELY_FCOMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHNELY"',
     *  'at line 2145 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00130,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00130(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSIZE_ENY"'
      CurrentAction2=
     *  'at line 2179 in the TAB file'
      CurrentIGNO=567
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSIZE_ENY"',
     *  'at line 2179 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(40)  ! SUM(i,ENY_FCOMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,ENY_FCOMM
      C00130(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSIZE_ENY"',
     *  'at line 2179 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFAS"'
      CurrentAction2=
     *  'at line 2182 in the TAB file'
      CurrentIGNO=568
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAS"',
     *  'at line 2182 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(40)  ! SUM(i,ENY_FCOMM
      RS1=RS1+C00116(SSMP(SSMPST(42)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(i,ENY_FCOMM
      C00117(3,I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFAS"',
     *  'at line 2182 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFA"'
      CurrentAction2=
     *  'at line 2184 in the TAB file'
      CurrentIGNO=570
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  'at line 2184 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      C00116(SSMP(SSMPST(43)-1+1),I00004,I00002)=C00117(3,I00004,I00002)
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFA"',
     *  'at line 2184 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00117,C00130,C00131,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      REAL C00130(1)
      REAL C00131(SSZ(40),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHENY"'
      CurrentAction2=
     *  'at line 2189 in the TAB file'
      CurrentIGNO=572
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHENY"',
     *  'at line 2189 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(40)  ! (all,i,ENY_FCOMM)
      LG1=C00117(3,I00004,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00130(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=40
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00131(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,ENY_FCOMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHENY"',
     *  'at line 2189 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,C00131,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      REAL C00131(SSZ(40),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHENY"'
      CurrentAction2=
     *  'at line 2191 in the TAB file'
      CurrentIGNO=573
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHENY"',
     *  'at line 2191 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(40)  ! (all,i,ENY_FCOMM)
      LG1=C00117(3,I00004,I00002).GT.0
      IF(LG1) THEN
      RS1=C00116(SSMP(SSMPST(42)-1+I00001),I00004,I00002)
      RS2=C00117(3,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=40
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00131(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,ENY_FCOMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHENY"',
     *  'at line 2191 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFAS"'
      CurrentAction2=
     *  'at line 2219 in the TAB file'
      CurrentIGNO=580
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAS"',
     *  'at line 2219 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(41)  ! SUM(i,KEN_FCOMM
      RS1=RS1+C00116(SSMP(SSMPST(44)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(i,KEN_FCOMM
      C00117(2,I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFAS"',
     *  'at line 2219 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFA"'
      CurrentAction2=
     *  'at line 2221 in the TAB file'
      CurrentIGNO=583
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  'at line 2221 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      C00116(SSMP(SSMPST(45)-1+1),I00004,I00002)=C00117(2,I00004,I00002)
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFA"',
     *  'at line 2221 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00133,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00133(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSIZE_KEN"'
      CurrentAction2=
     *  'at line 2226 in the TAB file'
      CurrentIGNO=585
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSIZE_KEN"',
     *  'at line 2226 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(41)  ! SUM(i,KEN_FCOMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,KEN_FCOMM
      C00133(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSIZE_KEN"',
     *  'at line 2226 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00117,C00133,C00134,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      REAL C00133(1)
      REAL C00134(SSZ(41),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHKEN"'
      CurrentAction2=
     *  'at line 2231 in the TAB file'
      CurrentIGNO=587
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHKEN"',
     *  'at line 2231 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(41)  ! (all,i,KEN_FCOMM)
      LG1=C00117(2,I00004,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00133(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=41
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00134(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,KEN_FCOMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHKEN"',
     *  'at line 2231 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,C00134,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      REAL C00134(SSZ(41),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHKEN"'
      CurrentAction2=
     *  'at line 2233 in the TAB file'
      CurrentIGNO=588
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHKEN"',
     *  'at line 2233 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(41)  ! (all,i,KEN_FCOMM)
      LG1=C00117(2,I00004,I00002).GT.0
      IF(LG1) THEN
      RS1=C00116(SSMP(SSMPST(44)-1+I00001),I00004,I00002)
      RS2=C00117(2,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=41
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00134(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,KEN_FCOMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHKEN"',
     *  'at line 2233 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00113')
      RETURN
      END
      SUBROUTINE M00005(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=8
       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(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=33
       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(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=34
       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(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(502).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVDFANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(502).NE.'n') then
      CALL S00088(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(502),
     *  C00024,C00025,C00119,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(506).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2DFVDFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(506).NE.'n') then
      CALL S00089(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(506),
     *  C00024,C00037,C00120,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(.NOT.POSTSIMPASS2.AND.(.NOT.POSTSIMPASS3)) THEN
      ZDZVAL=1
      END IF
      IF(ECHO1.AND.DOIG(511).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHVIFANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(511).NE.'n') then
      CALL S00090(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(511),
     *  C00026,C00027,C00121,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(515).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2IFVIFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(515).NE.'n') then
      CALL S00091(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(515),
     *  C00026,C00038,C00122,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(520).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FMSHR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(520).NE.'n') then
      CALL S00092(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(520),
     *  C00026,C00044,C00123,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(524).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(524).NE.'n') then
      CALL S00093(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(524),
     *  C00044,C00116,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(125,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=36
       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
      IF(ECHO1.AND.DOIG(536).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(536).NE.'n') then
      CALL S00094(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(536),
     *  C00116,C00117,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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=37
       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
      IF(ECHO1.AND.DOIG(539).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(539).NE.'n') then
      CALL S00095(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(539),
     *  C00116,C00117,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(541).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSIZE_NCOAL',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(541).NE.'n') then
      CALL S00096(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(541),
     *  C00124,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(543).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHNCOAL',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(543).NE.'n') then
      CALL S00097(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(543),
     *  C00117,C00124,C00125,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(544).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHNCOAL',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(544).NE.'n') then
      CALL S00098(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(544),
     *  C00116,C00117,C00125,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(128,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=38
       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
      IF(ECHO1.AND.DOIG(551).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(551).NE.'n') then
      CALL S00099(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(551),
     *  C00116,C00117,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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=39
       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
      IF(ECHO1.AND.DOIG(554).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(554).NE.'n') then
      CALL S00100(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(554),
     *  C00116,C00117,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(556).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSIZE_NELY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(556).NE.'n') then
      CALL S00101(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(556),
     *  C00127,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(558).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHNELY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(558).NE.'n') then
      CALL S00102(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(558),
     *  C00117,C00127,C00128,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(559).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHNELY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(559).NE.'n') then
      CALL S00103(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(559),
     *  C00116,C00117,C00128,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(131,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=40
       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
      IF(ECHO1.AND.DOIG(567).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSIZE_ENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(567).NE.'n') then
      CALL S00104(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(567),
     *  C00130,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(568).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(568).NE.'n') then
      CALL S00105(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(568),
     *  C00116,C00117,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=22
       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
      IF(ECHO1.AND.DOIG(570).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(570).NE.'n') then
      CALL S00106(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(570),
     *  C00116,C00117,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(572).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(572).NE.'n') then
      CALL S00107(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(572),
     *  C00117,C00130,C00131,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(573).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHENY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(573).NE.'n') then
      CALL S00108(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(573),
     *  C00116,C00117,C00131,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(134,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=41
       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
      IF(ECHO1.AND.DOIG(580).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(580).NE.'n') then
      CALL S00109(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(580),
     *  C00116,C00117,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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=42
       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
      IF(ECHO1.AND.DOIG(583).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(583).NE.'n') then
      CALL S00110(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(583),
     *  C00116,C00117,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(585).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSIZE_KEN',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(585).NE.'n') then
      CALL S00111(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(585),
     *  C00133,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(587).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHKEN',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(587).NE.'n') then
      CALL S00112(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(587),
     *  C00117,C00133,C00134,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(588).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHKEN',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(588).NE.'n') then
      CALL S00113(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(588),
     *  C00116,C00117,C00134,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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(137,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RETURN
15000 CALL PERET('M00005')
      RETURN
      END
      SUBROUTINE S00114(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00116,C00117,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFAS"'
      CurrentAction2=
     *  'at line 2267 in the TAB file'
      CurrentIGNO=598
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAS"',
     *  'at line 2267 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(44)  ! SUM(i,VAEN_FCOMM
      RS1=RS1+C00116(SSMP(SSMPST(48)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(i,VAEN_FCOMM
      C00117(1,I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFAS"',
     *  'at line 2267 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFA"'
      CurrentAction2=
     *  'at line 2269 in the TAB file'
      CurrentIGNO=601
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  'at line 2269 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      C00116(SSMP(SSMPST(49)-1+1),I00004,I00002)=C00117(1,I00004,I00002)
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFA"',
     *  'at line 2269 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00136,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00136(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSIZE_VAEN"'
      CurrentAction2=
     *  'at line 2274 in the TAB file'
      CurrentIGNO=603
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSIZE_VAEN"',
     *  'at line 2274 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(44)  ! SUM(i,VAEN_FCOMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,VAEN_FCOMM
      C00136(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSIZE_VAEN"',
     *  'at line 2274 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00117,C00136,C00137,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      REAL C00136(1)
      REAL C00137(SSZ(44),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHVAEN"'
      CurrentAction2=
     *  'at line 2280 in the TAB file'
      CurrentIGNO=605
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHVAEN"',
     *  'at line 2280 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(44)  ! (all,i,VAEN_FCOMM)
      LG1=C00117(1,I00004,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00136(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=44
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00137(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,VAEN_FCOMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHVAEN"',
     *  'at line 2280 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00117,C00137,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00117(SSZ(33),SSZ(7),SSZ(1))
      REAL C00137(SSZ(44),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHVAEN"'
      CurrentAction2=
     *  'at line 2282 in the TAB file'
      CurrentIGNO=606
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHVAEN"',
     *  'at line 2282 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(44)  ! (all,i,VAEN_FCOMM)
      LG1=C00117(1,I00004,I00002).GT.0
      IF(LG1) THEN
      RS1=C00116(SSMP(SSMPST(48)-1+I00001),I00004,I00002)
      RS2=C00117(1,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=44
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00137(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,VAEN_FCOMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHVAEN"',
     *  'at line 2282 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFAE"'
      CurrentAction2=
     *  'at line 2331 in the TAB file'
      CurrentIGNO=613
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAE"',
     *  'at line 2331 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(46)  ! SUM(i,EBL_COMM
      RS1=RS1+C00116(SSMP(SSMPST(50)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(i,EBL_COMM
      C00118(3,I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFAE"',
     *  'at line 2331 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFA"'
      CurrentAction2=
     *  'at line 2333 in the TAB file'
      CurrentIGNO=616
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  'at line 2333 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      C00116(SSMP(SSMPST(51)-1+1),I00004,I00002)=C00118(3,I00004,I00002)
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFA"',
     *  'at line 2333 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00139,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00139(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSIZE_EBL"'
      CurrentAction2=
     *  'at line 2338 in the TAB file'
      CurrentIGNO=618
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSIZE_EBL"',
     *  'at line 2338 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(46)  ! SUM(i,EBL_COMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,EBL_COMM
      C00139(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSIZE_EBL"',
     *  'at line 2338 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00118,C00139,C00140,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      REAL C00139(1)
      REAL C00140(SSZ(46),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHEBL"'
      CurrentAction2=
     *  'at line 2344 in the TAB file'
      CurrentIGNO=620
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHEBL"',
     *  'at line 2344 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(46)  ! (all,i,EBL_COMM)
      LG1=C00118(3,I00004,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00139(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=46
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00140(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,EBL_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHEBL"',
     *  'at line 2344 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,C00140,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      REAL C00140(SSZ(46),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHEBL"'
      CurrentAction2=
     *  'at line 2346 in the TAB file'
      CurrentIGNO=621
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHEBL"',
     *  'at line 2346 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(46)  ! (all,i,EBL_COMM)
      LG1=C00118(3,I00004,I00002).GT.0
      IF(LG1) THEN
      RS1=C00116(SSMP(SSMPST(50)-1+I00001),I00004,I00002)
      RS2=C00118(3,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=46
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00140(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,EBL_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHEBL"',
     *  'at line 2346 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFAE"'
      CurrentAction2=
     *  'at line 2377 in the TAB file'
      CurrentIGNO=628
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAE"',
     *  'at line 2377 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(48)  ! SUM(i,EPP_COMM
      RS1=RS1+C00116(SSMP(SSMPST(52)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(i,EPP_COMM
      C00118(4,I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFAE"',
     *  'at line 2377 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFA"'
      CurrentAction2=
     *  'at line 2379 in the TAB file'
      CurrentIGNO=631
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  'at line 2379 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      C00116(SSMP(SSMPST(53)-1+1),I00004,I00002)=C00118(4,I00004,I00002)
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFA"',
     *  'at line 2379 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00142,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00142(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSIZE_EPP"'
      CurrentAction2=
     *  'at line 2384 in the TAB file'
      CurrentIGNO=633
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSIZE_EPP"',
     *  'at line 2384 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(48)  ! SUM(i,EPP_COMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,EPP_COMM
      C00142(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSIZE_EPP"',
     *  'at line 2384 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00118,C00142,C00143,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      REAL C00142(1)
      REAL C00143(SSZ(48),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHEPP"'
      CurrentAction2=
     *  'at line 2390 in the TAB file'
      CurrentIGNO=635
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHEPP"',
     *  'at line 2390 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(48)  ! (all,i,EPP_COMM)
      LG1=C00118(4,I00004,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00142(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=48
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00143(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,EPP_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHEPP"',
     *  'at line 2390 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,C00143,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      REAL C00143(SSZ(48),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHEPP"'
      CurrentAction2=
     *  'at line 2392 in the TAB file'
      CurrentIGNO=636
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHEPP"',
     *  'at line 2392 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(48)  ! (all,i,EPP_COMM)
      LG1=C00118(4,I00004,I00002).GT.0
      IF(LG1) THEN
      RS1=C00116(SSMP(SSMPST(52)-1+I00001),I00004,I00002)
      RS2=C00118(4,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=48
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00143(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,EPP_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHEPP"',
     *  'at line 2392 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFAE"'
      CurrentAction2=
     *  'at line 2423 in the TAB file'
      CurrentIGNO=643
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAE"',
     *  'at line 2423 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(50)  ! SUM(i,EGEN_COMM
      RS1=RS1+C00116(SSMP(SSMPST(54)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(i,EGEN_COMM
      C00118(2,I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFAE"',
     *  'at line 2423 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFA"'
      CurrentAction2=
     *  'at line 2425 in the TAB file'
      CurrentIGNO=646
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  'at line 2425 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      C00116(SSMP(SSMPST(55)-1+1),I00004,I00002)=C00118(2,I00004,I00002)
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFA"',
     *  'at line 2425 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00145,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00145(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSIZE_EGEN"'
      CurrentAction2=
     *  'at line 2430 in the TAB file'
      CurrentIGNO=648
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSIZE_EGEN"',
     *  'at line 2430 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(50)  ! SUM(i,EGEN_COMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,EGEN_COMM
      C00145(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSIZE_EGEN"',
     *  'at line 2430 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00118,C00145,C00146,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      REAL C00145(1)
      REAL C00146(SSZ(50),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHEGEN"'
      CurrentAction2=
     *  'at line 2436 in the TAB file'
      CurrentIGNO=650
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHEGEN"',
     *  'at line 2436 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(50)  ! (all,i,EGEN_COMM)
      LG1=C00118(2,I00004,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00145(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=50
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00146(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,EGEN_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHEGEN"',
     *  'at line 2436 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,C00146,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      REAL C00146(SSZ(50),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHEGEN"'
      CurrentAction2=
     *  'at line 2438 in the TAB file'
      CurrentIGNO=651
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHEGEN"',
     *  'at line 2438 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(50)  ! (all,i,EGEN_COMM)
      LG1=C00118(2,I00004,I00002).GT.0
      IF(LG1) THEN
      RS1=C00116(SSMP(SSMPST(54)-1+I00001),I00004,I00002)
      RS2=C00118(2,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=50
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00146(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,EGEN_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHEGEN"',
     *  'at line 2438 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFAE"'
      CurrentAction2=
     *  'at line 2469 in the TAB file'
      CurrentIGNO=658
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFAE"',
     *  'at line 2469 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(52)  ! SUM(i,ELYO_COMM
      RS1=RS1+C00116(SSMP(SSMPST(56)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(i,ELYO_COMM
      C00118(1,I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFAE"',
     *  'at line 2469 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFA"'
      CurrentAction2=
     *  'at line 2471 in the TAB file'
      CurrentIGNO=661
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFA"',
     *  'at line 2471 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      C00116(SSMP(SSMPST(57)-1+1),I00004,I00002)=C00118(1,I00004,I00002)
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFA"',
     *  'at line 2471 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00148,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00148(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSIZE_ELYO"'
      CurrentAction2=
     *  'at line 2476 in the TAB file'
      CurrentIGNO=663
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSIZE_ELYO"',
     *  'at line 2476 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(52)  ! SUM(i,ELYO_COMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,ELYO_COMM
      C00148(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSIZE_ELYO"',
     *  'at line 2476 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00118,C00148,C00149,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      REAL C00148(1)
      REAL C00149(SSZ(52),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHELYO"'
      CurrentAction2=
     *  'at line 2482 in the TAB file'
      CurrentIGNO=665
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHELYO"',
     *  'at line 2482 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(52)  ! (all,i,ELYO_COMM)
      LG1=C00118(1,I00004,I00002).EQ.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00148(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=52
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00149(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,ELYO_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHELYO"',
     *  'at line 2482 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00118,C00149,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00118(SSZ(34),SSZ(7),SSZ(1))
      REAL C00149(SSZ(52),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHELYO"'
      CurrentAction2=
     *  'at line 2484 in the TAB file'
      CurrentIGNO=666
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHELYO"',
     *  'at line 2484 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(52)  ! (all,i,ELYO_COMM)
      LG1=C00118(1,I00004,I00002).GT.0
      IF(LG1) THEN
      RS1=C00116(SSMP(SSMPST(56)-1+I00001),I00004,I00002)
      RS2=C00118(1,I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=52
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00149(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,ELYO_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHELYO"',
     *  'at line 2484 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00138')
      RETURN
      END
      SUBROUTINE M00006(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,OVOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,DSPUN,DSPPW,DSPPL,DSPDEC,
     *  DODS,DOWR,DOEQ,DSALLS,WTALLS,KSTEPA,NPASSA,SERTAB,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  DSSMAP,SSMAP,
     *  DOUD,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE GSINC4
      USE gtap_c5
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER DSPUN,DSPPW,DSPPL,DSPDEC
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL DOUD
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DSALLS,WTALLS,DODS,DOWR,DOEQ,OVOK,SERTAB
      LOGICAL DSPANP,DSPOIM,D1DROW,NELTX
      INTEGER KSTEPA,NPASSA,DSPCPN,DSPCLN
      INTEGER DSSMAP,SSMAP(DSSMAP)
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER SSNO,LITSN,SETNO
      CHARACTER SSTP,SETTP
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOWMEM=.FALSE.
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=13
       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
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=43
       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
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=44
       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
      IF(ECHO1.AND.DOIG(598).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(598).NE.'n') then
      CALL S00114(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(598),
     *  C00116,C00117,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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=45
       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
      IF(ECHO1.AND.DOIG(601).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(601).NE.'n') then
      CALL S00115(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(601),
     *  C00116,C00117,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(603).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSIZE_VAEN',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(603).NE.'n') then
      CALL S00116(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(603),
     *  C00136,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(605).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHVAEN',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(605).NE.'n') then
      CALL S00117(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(605),
     *  C00117,C00136,C00137,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(606).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHVAEN',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(606).NE.'n') then
      CALL S00118(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(606),
     *  C00116,C00117,C00137,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(140,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=46
       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
      IF(ECHO1.AND.DOIG(613).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(613).NE.'n') then
      CALL S00119(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(613),
     *  C00116,C00118,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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=47
       SSNO=51
       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,51,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(616).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(616).NE.'n') then
      CALL S00120(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(616),
     *  C00116,C00118,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(618).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSIZE_EBL',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(618).NE.'n') then
      CALL S00121(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(618),
     *  C00139,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(620).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHEBL',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(620).NE.'n') then
      CALL S00122(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(620),
     *  C00118,C00139,C00140,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(621).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHEBL',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(621).NE.'n') then
      CALL S00123(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(621),
     *  C00116,C00118,C00140,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(143,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=48
       SSNO=52
       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,52,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(628).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(628).NE.'n') then
      CALL S00124(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(628),
     *  C00116,C00118,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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=49
       SSNO=53
       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,53,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(631).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(631).NE.'n') then
      CALL S00125(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(631),
     *  C00116,C00118,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(633).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSIZE_EPP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(633).NE.'n') then
      CALL S00126(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(633),
     *  C00142,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(635).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHEPP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(635).NE.'n') then
      CALL S00127(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(635),
     *  C00118,C00142,C00143,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(636).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHEPP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(636).NE.'n') then
      CALL S00128(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(636),
     *  C00116,C00118,C00143,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(146,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=50
       SSNO=54
       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,54,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(643).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(643).NE.'n') then
      CALL S00129(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(643),
     *  C00116,C00118,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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=51
       SSNO=55
       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,55,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(646).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(646).NE.'n') then
      CALL S00130(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(646),
     *  C00116,C00118,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(648).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSIZE_EGEN',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(648).NE.'n') then
      CALL S00131(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(648),
     *  C00145,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(650).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHEGEN',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(650).NE.'n') then
      CALL S00132(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(650),
     *  C00118,C00145,C00146,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(651).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHEGEN',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(651).NE.'n') then
      CALL S00133(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(651),
     *  C00116,C00118,C00146,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGSCRS('tg',1,CALC1,DODS,DOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,DSPUN,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  DSPPW,DSPPL,DSPDEC,MMR,MMRDR,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  DSALLS,WTALLS,WTMO,.FALSE.,
     *  DSPANP,DSPOIM,D1DROW,DSPCPN,DSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGST('tg',AXSUN,SETNO,MMNST,NUMST,SSZ,SZUB,
     *  STIST,ELAD,STNM,STELST,STTP,
     *  MMNFL,AFN,AFS,LFNORD,RDFSNO,RDUN,FSTPAS,
     *  MMNCS,CSPOS,CSPOSTSIM,MMNVC,VCWKST,
     *  DSSMP,SSMP,MMNSS,SSMPST,SERTAB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(PRELIM) THEN
       CALL SSAL1C(149,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=52
       SSNO=56
       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,56,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(658).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFAE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(658).NE.'n') then
      CALL S00134(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(658),
     *  C00116,C00118,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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=53
       SSNO=57
       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,57,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(661).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(661).NE.'n') then
      CALL S00135(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(661),
     *  C00116,C00118,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(663).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSIZE_ELYO',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(663).NE.'n') then
      CALL S00136(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(663),
     *  C00148,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(665).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHELYO',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(665).NE.'n') then
      CALL S00137(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(665),
     *  C00118,C00148,C00149,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(666).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHELYO',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(666).NE.'n') then
      CALL S00138(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(666),
     *  C00116,C00118,C00149,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00006')
      RETURN
      END
      SUBROUTINE S00139(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00116,C00152,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00152(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VFATOT"'
      CurrentAction2=
     *  'at line 2548 in the TAB file'
      CurrentIGNO=686
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VFATOT"',
     *  'at line 2548 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(56)  ! SUM(i,OUT_COMM
      RS1=RS1+C00116(SSMP(SSMPST(60)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(i,OUT_COMM
      C00152(I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VFATOT"',
     *  'at line 2548 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00153,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      INTEGER IS1,IS2
      LOGICAL ECHO1
      REAL C00153(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSIZE_OUT"'
      CurrentAction2=
     *  'at line 2553 in the TAB file'
      CurrentIGNO=688
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSIZE_OUT"',
     *  'at line 2553 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      IS1=0
      DO 1 I00001=1,SSZ(56)  ! SUM(i,OUT_COMM
      IS2=1
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS1=IS1+IS2
      ELSE
        IS1=GPINTOP('+',IS1,IS2)
      END IF
    1 CONTINUE  ! END SUM(i,OUT_COMM
      C00153(1)=IS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSIZE_OUT"',
     *  'at line 2553 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00152,C00153,C00154,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00152(SSZ(7),SSZ(1))
      REAL C00153(1)
      REAL C00154(SSZ(56),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHOUT"'
      CurrentAction2=
     *  'at line 2558 in the TAB file'
      CurrentIGNO=690
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHOUT"',
     *  'at line 2558 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      LG1=C00152(I00004,I00002).EQ.0.0
      IF(LG1) THEN
      RS1=1.0
      RS2=C00153(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=56
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00154(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,OUT_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHOUT"',
     *  'at line 2558 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00152,C00154,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00152(SSZ(7),SSZ(1))
      REAL C00154(SSZ(56),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FSHOUT"'
      CurrentAction2=
     *  'at line 2560 in the TAB file'
      CurrentIGNO=691
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FSHOUT"',
     *  'at line 2560 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG:)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      LG1=C00152(I00004,I00002).GT.0.0
      IF(LG1) THEN
      RS1=C00116(SSMP(SSMPST(60)-1+I00001),I00004,I00002)
      RS2=C00152(I00004,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=56
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00154(I00001,I00004,I00002)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,i,OUT_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FSHOUT"',
     *  'at line 2560 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00077,C00078,C00155,C00156,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00077(SSZ(1))
      REAL C00078(SSZ(1))
      REAL C00155(SSZ(1))
      REAL C00156(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "INVKERATIO"'
      CurrentAction2=
     *  'at line 2704 in the TAB file'
      CurrentIGNO=711
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INVKERATIO"',
     *  'at line 2704 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00077(I00002)
      RS2=C00155(I00002)+C00078(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00156(I00002)=RS3
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "INVKERATIO"',
     *  'at line 2704 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00031,C00045,C00157,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00007
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00157(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GRNETRATIO"'
      CurrentAction2=
     *  'at line 2720 in the TAB file'
      CurrentIGNO=714
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GRNETRATIO"',
     *  'at line 2720 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00007=1,SSZ(12)  ! SUM(h,ENDWC_COMM
      RS1=RS1+C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00007))),I00002)
    2 CONTINUE  ! END SUM(h,ENDWC_COMM
      RS2=0.0
      DO 3 I00007=1,SSZ(12)  ! SUM(h,ENDWC_COMM
      RS2=RS2+C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00007))),I00002)
    3 CONTINUE  ! END SUM(h,ENDWC_COMM
      RS3=RS1
      RS4=RS2-C00031(I00002)
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE
        RS5=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS3
         ErrorRVal2=RS4
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00157(I00002)=RS5
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GRNETRATIO"',
     *  'at line 2720 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00032,C00160,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00160(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "MSHRS"'
      CurrentAction2=
     *  'at line 2930 in the TAB file'
      CurrentIGNO=738
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "MSHRS"',
     *  'at line 2930 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 4 I00008=1,SSZ(1)  ! SUM(k,REG
      RS1=RS1+C00032(I00001,I00008,I00003)
    4 CONTINUE  ! END SUM(k,REG
      RS2=C00032(I00001,I00002,I00003)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
         ErrorIndName(3)='s           '
         ErrorIndVal(3)=I00003
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00160(I00001,I00002,I00003)=RS4
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "MSHRS"',
     *  'at line 2930 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00162,C00163,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00163(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTFSD"'
      CurrentAction2=
     *  'at line 3041 in the TAB file'
      CurrentIGNO=760
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTFSD"',
     *  'at line 3041 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 4 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS1=RS1+C00162(I00005,I00001,I00002,I00003)
    4 CONTINUE  ! END SUM(m,MARG_COMM
      C00163(I00001,I00002,I00003)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTFSD"',
     *  'at line 3041 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00162,C00164,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00164(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTMUSE"'
      CurrentAction2=
     *  'at line 3050 in the TAB file'
      CurrentIGNO=762
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMUSE"',
     *  'at line 3050 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00002=1,SSZ(1)  ! SUM(r,REG
      RS3=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS3=RS3+C00162(I00005,I00001,I00002,I00003)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS2=RS2+RS3
    3 CONTINUE  ! END SUM(r,REG
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00164(I00005)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTMUSE"',
     *  'at line 3050 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00036,C00165,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00165(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTMPROV"'
      CurrentAction2=
     *  'at line 3055 in the TAB file'
      CurrentIGNO=764
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMPROV"',
     *  'at line 3055 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00036(I00005,I00002)
    2 CONTINUE  ! END SUM(r,REG
      C00165(I00005)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTMPROV"',
     *  'at line 3055 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00036,C00166,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00166(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTRPROV"'
      CurrentAction2=
     *  'at line 3063 in the TAB file'
      CurrentIGNO=766
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTRPROV"',
     *  'at line 3063 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS1=RS1+C00036(I00005,I00002)
    2 CONTINUE  ! END SUM(m,MARG_COMM
      C00166(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTRPROV"',
     *  'at line 3063 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00036,C00167,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00167(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VT"'
      CurrentAction2=
     *  'at line 3068 in the TAB file'
      CurrentIGNO=768
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VT"',
     *  'at line 3068 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      RS1=0.0
      DO 2 I00002=1,SSZ(1)  ! SUM(r,REG
      RS2=0.0
      DO 1 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS2=RS2+C00036(I00005,I00002)
    1 CONTINUE  ! END SUM(m,MARG_COMM
      RS1=RS1+RS2
    2 CONTINUE  ! END SUM(r,REG
      C00167(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VT"',
     *  'at line 3068 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00163,C00167,C00168,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00163(SSZ(2),SSZ(1),SSZ(1))
      REAL C00167(1)
      REAL C00168(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTMUSESHR"'
      CurrentAction2=
     *  'at line 3098 in the TAB file'
      CurrentIGNO=771
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMUSESHR"',
     *  'at line 3098 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=C00163(I00001,I00002,I00003)
      RS2=C00167(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=4
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='i           '
         ErrorIndVal(2)=I00001
         ErrorIndSetNo(2)=2
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
         ErrorIndName(4)='s           '
         ErrorIndVal(4)=I00003
         ErrorIndSetNo(4)=1
        END IF
      END IF
      C00168(I00005,I00001,I00002,I00003)=RS3
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    3 CONTINUE  ! END (all,r,REG)
    4 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTMUSESHR"',
     *  'at line 3098 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00162,C00164,C00168,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00164(SSZ(3))
      REAL C00168(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTMUSESHR"'
      CurrentAction2=
     *  'at line 3100 in the TAB file'
      CurrentIGNO=772
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMUSESHR"',
     *  'at line 3100 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM:)
      LG1=C00164(I00005).NE.0.0
      IF(LG1) THEN
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00162(I00005,I00001,I00002,I00003)
      RS2=C00164(I00005)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=4
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='i           '
         ErrorIndVal(2)=I00001
         ErrorIndSetNo(2)=2
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
         ErrorIndName(4)='s           '
         ErrorIndVal(4)=I00003
         ErrorIndSetNo(4)=1
        END IF
      END IF
      C00168(I00005,I00001,I00002,I00003)=RS3
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    3 CONTINUE  ! END (all,r,REG)
    4 CONTINUE  ! END (all,s,REG)
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,m,MARG_COMM)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTMUSESHR"',
     *  'at line 3100 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00166,C00167,C00169,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00166(SSZ(1))
      REAL C00167(1)
      REAL C00169(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTSUPPSHR"'
      CurrentAction2=
     *  'at line 3119 in the TAB file'
      CurrentIGNO=775
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTSUPPSHR"',
     *  'at line 3119 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=C00166(I00002)
      RS2=C00167(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00169(I00005,I00002)=RS3
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTSUPPSHR"',
     *  'at line 3119 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00036,C00165,C00169,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00165(SSZ(3))
      REAL C00169(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTSUPPSHR"'
      CurrentAction2=
     *  'at line 3121 in the TAB file'
      CurrentIGNO=776
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTSUPPSHR"',
     *  'at line 3121 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM:)
      LG1=C00165(I00005).NE.0.0
      IF(LG1) THEN
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00036(I00005,I00002)
      RS2=C00165(I00005)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00169(I00005,I00002)=RS3
    2 CONTINUE  ! END (all,r,REG)
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,m,MARG_COMM)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTSUPPSHR"',
     *  'at line 3121 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00162,C00170,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00170(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTUSE"'
      CurrentAction2=
     *  'at line 3141 in the TAB file'
      CurrentIGNO=779
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTUSE"',
     *  'at line 3141 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00002=1,SSZ(1)  ! SUM(r,REG
      RS3=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS4=0.0
      DO 1 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS4=RS4+C00162(I00005,I00001,I00002,I00003)
    1 CONTINUE  ! END SUM(m,MARG_COMM
      RS3=RS3+RS4
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS2=RS2+RS3
    3 CONTINUE  ! END SUM(r,REG
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00170(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTUSE"',
     *  'at line 3141 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00162,C00163,C00171,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00163(SSZ(2),SSZ(1),SSZ(1))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTFSD_MSH"'
      CurrentAction2=
     *  'at line 3148 in the TAB file'
      CurrentIGNO=781
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTFSD_MSH"',
     *  'at line 3148 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG:)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      LG1=C00163(I00001,I00002,I00003).GT.0.0
      IF(LG1) THEN
      RS1=C00162(I00005,I00001,I00002,I00003)
      RS2=C00163(I00001,I00002,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=4
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='i           '
         ErrorIndVal(2)=I00001
         ErrorIndSetNo(2)=2
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
         ErrorIndName(4)='s           '
         ErrorIndVal(4)=I00003
         ErrorIndSetNo(4)=1
        END IF
      END IF
      C00171(I00005,I00001,I00002,I00003)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    3 CONTINUE  ! END (all,r,REG)
    4 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTFSD_MSH"',
     *  'at line 3148 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00163,C00164,C00170,C00171,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL LG1
      LOGICAL ECHO1
      REAL C00163(SSZ(2),SSZ(1),SSZ(1))
      REAL C00164(SSZ(3))
      REAL C00170(1)
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTFSD_MSH"'
      CurrentAction2=
     *  'at line 3151 in the TAB file'
      CurrentIGNO=782
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTFSD_MSH"',
     *  'at line 3151 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG:)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      LG1=C00163(I00001,I00002,I00003).EQ.0.0
      IF(LG1) THEN
      RS1=C00164(I00005)
      RS2=C00170(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=4
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='i           '
         ErrorIndVal(2)=I00001
         ErrorIndSetNo(2)=2
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
         ErrorIndName(4)='s           '
         ErrorIndVal(4)=I00003
         ErrorIndSetNo(4)=1
        END IF
      END IF
      C00171(I00005,I00001,I00002,I00003)=RS3
      END IF ! IF(LG1) THEN
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    3 CONTINUE  ! END (all,r,REG)
    4 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTFSD_MSH"',
     *  'at line 3151 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00163,C00172,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00163(SSZ(2),SSZ(1),SSZ(1))
      REAL C00172(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VIWSCOST"'
      CurrentAction2=
     *  'at line 3179 in the TAB file'
      CurrentIGNO=787
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWSCOST"',
     *  'at line 3179 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      C00172(I00001,I00002,I00003)=C00034(I00001,I00002,I00003)+
     *  C00163(I00001,I00002,I00003)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VIWSCOST"',
     *  'at line 3179 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00172,C00173,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00172(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FOBSHR"'
      CurrentAction2=
     *  'at line 3184 in the TAB file'
      CurrentIGNO=789
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FOBSHR"',
     *  'at line 3184 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00034(I00001,I00002,I00003)
      RS2=C00172(I00001,I00002,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
         ErrorIndName(3)='s           '
         ErrorIndVal(3)=I00003
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00173(I00001,I00002,I00003)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FOBSHR"',
     *  'at line 3184 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00163,C00172,C00174,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00163(SSZ(2),SSZ(1),SSZ(1))
      REAL C00172(SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TRNSHR"'
      CurrentAction2=
     *  'at line 3189 in the TAB file'
      CurrentIGNO=791
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TRNSHR"',
     *  'at line 3189 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00163(I00001,I00002,I00003)
      RS2=C00172(I00001,I00002,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
         ErrorIndName(3)='s           '
         ErrorIndVal(3)=I00003
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00174(I00001,I00002,I00003)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TRNSHR"',
     *  'at line 3189 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00008,C00175,C00176,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00006
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00175(SSZ(1))
      REAL C00176(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "CO2QB"'
      CurrentAction2=
     *  'at line 3245 in the TAB file'
      CurrentIGNO=804
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CO2QB"',
     *  'at line 3245 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00006=1,SSZ(17)  ! (all,b,BLOC)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)  ! SUM(r,REG:
      LG1=C00008(I00002).EQ.I00006
      IF(LG1) THEN
      RS1=RS1+C00175(I00002)
      END IF ! IF(LG1) THEN
    2 CONTINUE  ! END SUM(r,REG
      C00176(I00006)=RS1
    1 CONTINUE  ! END (all,b,BLOC)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "CO2QB"',
     *  'at line 3245 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00051,C00052,C00177,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00051(SSZ(1))
      REAL C00052(SSZ(1))
      REAL C00177(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "XSHRPRIV"'
      CurrentAction2=
     *  'at line 3281 in the TAB file'
      CurrentIGNO=809
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRPRIV"',
     *  'at line 3281 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00051(I00002)
      RS2=C00052(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00177(I00002)=RS3
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "XSHRPRIV"',
     *  'at line 3281 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00162')
      RETURN
      END
      SUBROUTINE S00163(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00049,C00052,C00178,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00049(SSZ(1))
      REAL C00052(SSZ(1))
      REAL C00178(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "XSHRGOV"'
      CurrentAction2=
     *  'at line 3286 in the TAB file'
      CurrentIGNO=811
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRGOV"',
     *  'at line 3286 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00049(I00002)
      RS2=C00052(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00178(I00002)=RS3
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "XSHRGOV"',
     *  'at line 3286 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00009,C00052,C00179,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00052(SSZ(1))
      REAL C00179(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "XSHRSAVE"'
      CurrentAction2=
     *  'at line 3291 in the TAB file'
      CurrentIGNO=813
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRSAVE"',
     *  'at line 3291 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00009(I00002)
      RS2=C00052(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00179(I00002)=RS3
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "XSHRSAVE"',
     *  'at line 3291 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00070,C00180,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00180(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TINC"'
      CurrentAction2=
     *  'at line 3318 in the TAB file'
      CurrentIGNO=821
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TINC"',
     *  'at line 3318 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      RS1=RS1+C00070(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE  ! END SUM(i,ENDW_COMM
      C00180(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TINC"',
     *  'at line 3318 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00028,C00181,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00028(SSZ(6),SSZ(7),SSZ(1))
      REAL C00181(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "REVSHR"'
      CurrentAction2=
     *  'at line 3330 in the TAB file'
      CurrentIGNO=824
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "REVSHR"',
     *  'at line 3330 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RS1=0.0
      DO 4 I00008=1,SSZ(7)  ! SUM(k,PROD_COMM
      RS1=RS1+C00028(I00001,I00008,I00002)
    4 CONTINUE  ! END SUM(k,PROD_COMM
      RS2=C00028(I00001,I00004,I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=6
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00181(I00001,I00004,I00002)=RS4
    1 CONTINUE  ! END (all,i,ENDW_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "REVSHR"',
     *  'at line 3330 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00183,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00183(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "PIND"'
      CurrentAction2=
     *  'at line 3419 in the TAB file'
      CurrentIGNO=842
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PIND"',
     *  'at line 3419 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00183(I00002)=1.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "PIND"',
     *  'at line 3419 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00008,C00052,C00184,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00006
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL LG1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00052(SSZ(1))
      REAL C00184(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "INCOMEB"'
      CurrentAction2=
     *  'at line 3432 in the TAB file'
      CurrentIGNO=847
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INCOMEB"',
     *  'at line 3432 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00006=1,SSZ(17)  ! (all,b,BLOC)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)  ! SUM(r,REG:
      LG1=C00008(I00002).EQ.I00006
      IF(LG1) THEN
      RS1=RS1+C00052(I00002)
      END IF ! IF(LG1) THEN
    2 CONTINUE  ! END SUM(r,REG
      C00184(I00006)=RS1
    1 CONTINUE  ! END (all,b,BLOC)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "INCOMEB"',
     *  'at line 3432 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00185,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00006
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00185(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "PINDB"'
      CurrentAction2=
     *  'at line 3444 in the TAB file'
      CurrentIGNO=852
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PINDB"',
     *  'at line 3444 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00006=1,SSZ(17)  ! (all,b,BLOC)
      C00185(I00006)=1.0
    1 CONTINUE  ! END (all,b,BLOC)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "PINDB"',
     *  'at line 3444 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00008,C00043,C00082,C00083,C00186,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00006
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL LG1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00043(SSZ(1))
      REAL C00082(SSZ(1))
      REAL C00083(SSZ(17))
      REAL C00186(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "NCTAXLEVB"'
      CurrentAction2=
     *  'at line 3448 in the TAB file'
      CurrentIGNO=855
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "NCTAXLEVB"',
     *  'at line 3448 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00006=1,SSZ(17)  ! (all,b,BLOC)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)  ! SUM(r,REG:
      LG1=C00008(I00002).EQ.I00006
      IF(LG1) THEN
      RS1=RS1+C00043(I00002)*C00082(I00002)
      END IF ! IF(LG1) THEN
    2 CONTINUE  ! END SUM(r,REG
      RS2=RS1
      RS3=C00083(I00006)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='b           '
         ErrorIndVal(1)=I00006
         ErrorIndSetNo(1)=17
        END IF
      END IF
      C00186(I00006)=RS4
    1 CONTINUE  ! END (all,b,BLOC)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "NCTAXLEVB"',
     *  'at line 3448 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00170')
      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
      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(154,MMNST,SSZ,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(PRELIM.OR.POSTSIMPASS2) THEN
       LITSN=54
       SSNO=58
       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,58,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=55
       SSNO=59
       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,59,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=56
       SSNO=60
       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,60,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
      IF(ECHO1.AND.DOIG(686).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VFATOT',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(686).NE.'n') then
      CALL S00139(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(686),
     *  C00116,C00152,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(688).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSIZE_OUT',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(688).NE.'n') then
      CALL S00140(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(688),
     *  C00153,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(690).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHOUT',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(690).NE.'n') then
      CALL S00141(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(690),
     *  C00152,C00153,C00154,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(691).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FSHOUT',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(691).NE.'n') then
      CALL S00142(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(691),
     *  C00116,C00152,C00154,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(711).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INVKERATIO',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(711).NE.'n') then
      CALL S00143(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(711),
     *  C00077,C00078,C00155,C00156,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(714).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GRNETRATIO',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(714).NE.'n') then
      CALL S00144(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(714),
     *  C00031,C00045,C00157,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(738).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'MSHRS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(738).NE.'n') then
      CALL S00145(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(738),
     *  C00032,C00160,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(760).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(760).NE.'n') then
      CALL S00146(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(760),
     *  C00162,C00163,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(762).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(762).NE.'n') then
      CALL S00147(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(762),
     *  C00162,C00164,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(764).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMPROV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(764).NE.'n') then
      CALL S00148(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(764),
     *  C00036,C00165,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(766).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTRPROV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(766).NE.'n') then
      CALL S00149(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(766),
     *  C00036,C00166,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(768).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VT',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(768).NE.'n') then
      CALL S00150(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(768),
     *  C00036,C00167,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(771).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSESHR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(771).NE.'n') then
      CALL S00151(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(771),
     *  C00163,C00167,C00168,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(772).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMUSESHR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(772).NE.'n') then
      CALL S00152(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(772),
     *  C00162,C00164,C00168,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(775).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTSUPPSHR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(775).NE.'n') then
      CALL S00153(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(775),
     *  C00166,C00167,C00169,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(776).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTSUPPSHR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(776).NE.'n') then
      CALL S00154(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(776),
     *  C00036,C00165,C00169,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(779).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTUSE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(779).NE.'n') then
      CALL S00155(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(779),
     *  C00162,C00170,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(781).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD_MSH',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(781).NE.'n') then
      CALL S00156(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(781),
     *  C00162,C00163,C00171,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(782).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTFSD_MSH',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(782).NE.'n') then
      CALL S00157(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(782),
     *  C00163,C00164,C00170,C00171,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(787).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWSCOST',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(787).NE.'n') then
      CALL S00158(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(787),
     *  C00034,C00163,C00172,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(789).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FOBSHR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(789).NE.'n') then
      CALL S00159(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(789),
     *  C00034,C00172,C00173,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(791).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TRNSHR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(791).NE.'n') then
      CALL S00160(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(791),
     *  C00163,C00172,C00174,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(804).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CO2QB',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(804).NE.'n') then
      CALL S00161(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(804),
     *  C00008,C00175,C00176,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(809).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRPRIV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(809).NE.'n') then
      CALL S00162(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(809),
     *  C00051,C00052,C00177,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(811).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRGOV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(811).NE.'n') then
      CALL S00163(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(811),
     *  C00049,C00052,C00178,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(813).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRSAVE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(813).NE.'n') then
      CALL S00164(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(813),
     *  C00009,C00052,C00179,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(821).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TINC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(821).NE.'n') then
      CALL S00165(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(821),
     *  C00070,C00180,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(824).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'REVSHR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(824).NE.'n') then
      CALL S00166(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(824),
     *  C00028,C00181,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(842).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PIND',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(842).NE.'n') then
      CALL S00167(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(842),
     *  C00183,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(847).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INCOMEB',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(847).NE.'n') then
      CALL S00168(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(847),
     *  C00008,C00052,C00184,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(852).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PINDB',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(852).NE.'n') then
      CALL S00169(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(852),
     *  C00185,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(855).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'NCTAXLEVB',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(855).NE.'n') then
      CALL S00170(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(855),
     *  C00008,C00043,C00082,C00083,C00186,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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
      RETURN
15000 CALL PERET('M00007')
      RETURN
      END
      SUBROUTINE S00171(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00031,C00047,C00188,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00188(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "FY"'
      CurrentAction2=
     *  'at line 3483 in the TAB file'
      CurrentIGNO=863
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "FY"',
     *  'at line 3483 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      RS1=RS1+C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE  ! END SUM(i,ENDW_COMM
      C00188(I00002)=RS1-C00031(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "FY"',
     *  'at line 3483 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00057,C00062,C00067,C00069,C00071,C00073,C00075,C00189,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00057(SSZ(1))
      REAL C00062(SSZ(1))
      REAL C00067(SSZ(1))
      REAL C00069(SSZ(1))
      REAL C00071(SSZ(1))
      REAL C00073(SSZ(1))
      REAL C00075(SSZ(1))
      REAL C00189(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "INDTAX"'
      CurrentAction2=
     *  'at line 3533 in the TAB file'
      CurrentIGNO=874
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INDTAX"',
     *  'at line 3533 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00189(I00002)=C00062(I00002)+C00067(I00002)+C00057(I00002)+
     *  C00069(I00002)+C00071(I00002)+C00073(I00002)+C00075(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "INDTAX"',
     *  'at line 3533 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00080,C00177,C00178,C00179,C00190,C00191,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00080(SSZ(1))
      REAL C00177(SSZ(1))
      REAL C00178(SSZ(1))
      REAL C00179(SSZ(1))
      REAL C00190(SSZ(1))
      REAL C00191(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "UTILELAS"'
      CurrentAction2=
     *  'at line 3618 in the TAB file'
      CurrentIGNO=889
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILELAS"',
     *  'at line 3618 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00080(I00002)*C00177(I00002)+C00178(I00002)+C00179(I00002)
      RS2=C00190(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00191(I00002)=RS3
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "UTILELAS"',
     *  'at line 3618 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00080,C00177,C00191,C00192,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00080(SSZ(1))
      REAL C00177(SSZ(1))
      REAL C00191(SSZ(1))
      REAL C00192(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "DPARPRIV"'
      CurrentAction2=
     *  'at line 3624 in the TAB file'
      CurrentIGNO=891
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPARPRIV"',
     *  'at line 3624 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00080(I00002)*C00177(I00002)
      RS2=C00191(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00192(I00002)=RS3
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "DPARPRIV"',
     *  'at line 3624 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00178,C00191,C00193,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00178(SSZ(1))
      REAL C00191(SSZ(1))
      REAL C00193(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "DPARGOV"'
      CurrentAction2=
     *  'at line 3629 in the TAB file'
      CurrentIGNO=893
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPARGOV"',
     *  'at line 3629 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00178(I00002)
      RS2=C00191(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00193(I00002)=RS3
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "DPARGOV"',
     *  'at line 3629 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00179,C00191,C00194,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00179(SSZ(1))
      REAL C00191(SSZ(1))
      REAL C00194(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "DPARSAVE"'
      CurrentAction2=
     *  'at line 3634 in the TAB file'
      CurrentIGNO=895
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "DPARSAVE"',
     *  'at line 3634 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00179(I00002)
      RS2=C00191(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00194(I00002)=RS3
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "DPARSAVE"',
     *  'at line 3634 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00195,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00195(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "UTILPRIV"'
      CurrentAction2=
     *  'at line 3639 in the TAB file'
      CurrentIGNO=897
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILPRIV"',
     *  'at line 3639 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00195(I00002)=1.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "UTILPRIV"',
     *  'at line 3639 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00196,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00196(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "UTILGOV"'
      CurrentAction2=
     *  'at line 3646 in the TAB file'
      CurrentIGNO=901
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILGOV"',
     *  'at line 3646 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00196(I00002)=1.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "UTILGOV"',
     *  'at line 3646 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00197,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00197(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "UTILSAVE"'
      CurrentAction2=
     *  'at line 3653 in the TAB file'
      CurrentIGNO=905
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILSAVE"',
     *  'at line 3653 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00197(I00002)=1.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "UTILSAVE"',
     *  'at line 3653 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00030,C00046,C00198,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00030(SSZ(2),SSZ(7),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00198(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHRDFM"'
      CurrentAction2=
     *  'at line 3696 in the TAB file'
      CurrentIGNO=912
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDFM"',
     *  'at line 3696 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00030(I00001,I00004,I00002)
      RS2=C00046(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00198(I00001,I00004,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHRDFM"',
     *  'at line 3696 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00018,C00046,C00199,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00018(SSZ(2),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00199(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHRDPM"'
      CurrentAction2=
     *  'at line 3701 in the TAB file'
      CurrentIGNO=914
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDPM"',
     *  'at line 3701 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00018(I00001,I00002)
      RS2=C00046(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00199(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHRDPM"',
     *  'at line 3701 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00012,C00046,C00200,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00012(SSZ(2),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00200(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHRDGM"'
      CurrentAction2=
     *  'at line 3706 in the TAB file'
      CurrentIGNO=916
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDGM"',
     *  'at line 3706 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00012(I00001,I00002)
      RS2=C00046(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00200(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHRDGM"',
     *  'at line 3706 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00046,C00047,C00201,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00201(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHRDM"'
      CurrentAction2=
     *  'at line 3721 in the TAB file'
      CurrentIGNO=920
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRDM"',
     *  'at line 3721 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00046(I00001,I00002)
      RS2=C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00201(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHRDM"',
     *  'at line 3721 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00036,C00047,C00202,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00202(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHRST"'
      CurrentAction2=
     *  'at line 3726 in the TAB file'
      CurrentIGNO=922
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRST"',
     *  'at line 3726 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=C00036(I00005,I00002)
      RS2=C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005))),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00202(I00005,I00002)=RS3
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHRST"',
     *  'at line 3726 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00035,C00047,C00203,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00203(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHRXMD"'
      CurrentAction2=
     *  'at line 3731 in the TAB file'
      CurrentIGNO=924
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRXMD"',
     *  'at line 3731 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00035(I00001,I00002,I00003)
      RS2=C00047(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
         ErrorIndName(3)='s           '
         ErrorIndVal(3)=I00003
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00203(I00001,I00002,I00003)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHRXMD"',
     *  'at line 3731 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00015,C00021,C00029,C00204,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00015(SSZ(2),SSZ(1))
      REAL C00021(SSZ(2),SSZ(1))
      REAL C00029(SSZ(2),SSZ(7),SSZ(1))
      REAL C00204(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VIM"'
      CurrentAction2=
     *  'at line 3760 in the TAB file'
      CurrentIGNO=929
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIM"',
     *  'at line 3760 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00029(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00204(I00001,I00002)=RS1+C00021(I00001,I00002)+
     *  C00015(I00001,I00002)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VIM"',
     *  'at line 3760 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00029,C00204,C00205,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00029(SSZ(2),SSZ(7),SSZ(1))
      REAL C00204(SSZ(2),SSZ(1))
      REAL C00205(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHRIFM"'
      CurrentAction2=
     *  'at line 3765 in the TAB file'
      CurrentIGNO=931
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRIFM"',
     *  'at line 3765 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00029(I00001,I00004,I00002)
      RS2=C00204(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00205(I00001,I00004,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHRIFM"',
     *  'at line 3765 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00021,C00204,C00206,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00021(SSZ(2),SSZ(1))
      REAL C00204(SSZ(2),SSZ(1))
      REAL C00206(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHRIPM"'
      CurrentAction2=
     *  'at line 3770 in the TAB file'
      CurrentIGNO=933
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRIPM"',
     *  'at line 3770 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00021(I00001,I00002)
      RS2=C00204(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00206(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHRIPM"',
     *  'at line 3770 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00015,C00204,C00207,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00015(SSZ(2),SSZ(1))
      REAL C00204(SSZ(2),SSZ(1))
      REAL C00207(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHRIGM"'
      CurrentAction2=
     *  'at line 3775 in the TAB file'
      CurrentIGNO=935
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHRIGM"',
     *  'at line 3775 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00015(I00001,I00002)
      RS2=C00204(I00001,I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00207(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHRIGM"',
     *  'at line 3775 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00028,C00047,C00208,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00028(SSZ(6),SSZ(7),SSZ(1))
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00208(SSZ(11),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SHREM"'
      CurrentAction2=
     *  'at line 3788 in the TAB file'
      CurrentIGNO=938
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SHREM"',
     *  'at line 3788 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(11)  ! (all,i,ENDWM_COMM)
      RS1=C00028(SSMP(SSMPST(11)-1+I00001),I00004,I00002)
      RS2=C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001))),I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=11
         ErrorIndName(2)='j           '
         ErrorIndVal(2)=I00004
         ErrorIndSetNo(2)=7
         ErrorIndName(3)='r           '
         ErrorIndVal(3)=I00002
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00208(I00001,I00004,I00002)=RS3
    1 CONTINUE  ! END (all,i,ENDWM_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SHREM"',
     *  'at line 3788 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00036,C00209,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00209(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VXW"'
      CurrentAction2=
     *  'at line 3901 in the TAB file'
      CurrentIGNO=952
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXW"',
     *  'at line 3901 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00209(SSMP(SSMPST(1)-1+I00005),I00002)=RS1+C00036(I00005,I00002)
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VXW"',
     *  'at line 3901 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00209,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00209(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VXW"'
      CurrentAction2=
     *  'at line 3903 in the TAB file'
      CurrentIGNO=953
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXW"',
     *  'at line 3903 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00209(SSMP(SSMPST(2)-1+I00001),I00002)=RS1
    1 CONTINUE  ! END (all,i,NMRG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VXW"',
     *  'at line 3903 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00209,C00210,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00209(SSZ(2),SSZ(1))
      REAL C00210(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VXWREGION"'
      CurrentAction2=
     *  'at line 3908 in the TAB file'
      CurrentIGNO=955
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXWREGION"',
     *  'at line 3908 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00209(I00001,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00210(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VXWREGION"',
     *  'at line 3908 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00033,C00211,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00211(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VIW"'
      CurrentAction2=
     *  'at line 3913 in the TAB file'
      CurrentIGNO=957
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIW"',
     *  'at line 3913 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00033(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(r,REG
      C00211(I00001,I00003)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VIW"',
     *  'at line 3913 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00211,C00212,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00211(SSZ(2),SSZ(1))
      REAL C00212(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VIWREGION"'
      CurrentAction2=
     *  'at line 3917 in the TAB file'
      CurrentIGNO=959
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWREGION"',
     *  'at line 3917 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00211(I00001,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00212(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VIWREGION"',
     *  'at line 3917 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00047,C00213,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00047(SSZ(9),SSZ(1))
      REAL C00213(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VENDWREG"'
      CurrentAction2=
     *  'at line 3939 in the TAB file'
      CurrentIGNO=963
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VENDWREG"',
     *  'at line 3939 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      RS1=RS1+C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE  ! END SUM(i,ENDW_COMM
      C00213(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VENDWREG"',
     *  'at line 3939 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00196')
      RETURN
      END
      SUBROUTINE S00197(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00213,C00214,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00213(SSZ(1))
      REAL C00214(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VENDWWLD"'
      CurrentAction2=
     *  'at line 3951 in the TAB file'
      CurrentIGNO=967
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VENDWWLD"',
     *  'at line 3951 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      RS1=0.0
      DO 1 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00213(I00002)
    1 CONTINUE  ! END SUM(r,REG
      C00214(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VENDWWLD"',
     *  'at line 3951 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00033,C00034,C00036,C00045,C00048,C00050,C00215,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00215(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GDP"'
      CurrentAction2=
     *  'at line 4009 in the TAB file'
      CurrentIGNO=977
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GDP"',
     *  'at line 4009 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00050(I00001,I00003)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00048(I00001,I00003)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS3=0.0
      DO 4 I00008=1,SSZ(5)  ! SUM(k,CGDS_COMM
      RS3=RS3+C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00008)),I00003)
    4 CONTINUE  ! END SUM(k,CGDS_COMM
      RS4=0.0
      DO 6 I00002=1,SSZ(1)  ! SUM(r,REG
      RS5=0.0
      DO 5 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS5=RS5+C00034(I00001,I00003,I00002)
    5 CONTINUE  ! END SUM(i,TRAD_COMM
      RS4=RS4+RS5
    6 CONTINUE  ! END SUM(r,REG
      RS6=0.0
      DO 7 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS6=RS6+C00036(I00005,I00003)
    7 CONTINUE  ! END SUM(m,MARG_COMM
      RS7=0.0
      DO 9 I00002=1,SSZ(1)  ! SUM(r,REG
      RS8=0.0
      DO 8 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS8=RS8+C00033(I00001,I00002,I00003)
    8 CONTINUE  ! END SUM(i,TRAD_COMM
      RS7=RS7+RS8
    9 CONTINUE  ! END SUM(r,REG
      C00215(I00003)=RS1+RS2+RS3+RS4+RS6-RS7
    1 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GDP"',
     *  'at line 4009 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00209,C00216,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00209(SSZ(2),SSZ(1))
      REAL C00216(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VXWCOMMOD"'
      CurrentAction2=
     *  'at line 4100 in the TAB file'
      CurrentIGNO=988
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXWCOMMOD"',
     *  'at line 4100 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00209(I00001,I00002)
    2 CONTINUE  ! END SUM(r,REG
      C00216(I00001)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VXWCOMMOD"',
     *  'at line 4100 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00210,C00217,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00210(SSZ(1))
      REAL C00217(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VXWLD"'
      CurrentAction2=
     *  'at line 4105 in the TAB file'
      CurrentIGNO=990
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VXWLD"',
     *  'at line 4105 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      RS1=0.0
      DO 1 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00210(I00002)
    1 CONTINUE  ! END SUM(r,REG
      C00217(1)=RS1
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VXWLD"',
     *  'at line 4105 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00211,C00218,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00211(SSZ(2),SSZ(1))
      REAL C00218(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VIWCOMMOD"'
      CurrentAction2=
     *  'at line 4110 in the TAB file'
      CurrentIGNO=992
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWCOMMOD"',
     *  'at line 4110 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00211(I00001,I00002)
    2 CONTINUE  ! END SUM(r,REG
      C00218(I00001)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VIWCOMMOD"',
     *  'at line 4110 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00035,C00219,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00219(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "PW_PM"'
      CurrentAction2=
     *  'at line 4115 in the TAB file'
      CurrentIGNO=994
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PW_PM"',
     *  'at line 4115 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      RS2=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=RS2+C00035(I00001,I00002,I00003)
    4 CONTINUE  ! END SUM(s,REG
      RS3=RS1
      RS4=RS2
      IF(RS4.NE.0.0) THEN
        RS5=RS3/RS4
      ELSE
        RS5=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS3
         ErrorRVal2=RS4
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00219(I00001,I00002)=RS5
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "PW_PM"',
     *  'at line 4115 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00036,C00046,C00219,C00220,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00219(SSZ(2),SSZ(1))
      REAL C00220(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VOW"'
      CurrentAction2=
     *  'at line 4119 in the TAB file'
      CurrentIGNO=996
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOW"',
     *  'at line 4119 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00220(SSMP(SSMPST(1)-1+I00005),I00002)=C00046(SSMP(SSMPST(1)-1+
     *  I00005),I00002)*C00219(SSMP(SSMPST(1)-1+I00005),I00002)+RS1+
     *  C00036(I00005,I00002)
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VOW"',
     *  'at line 4119 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00046,C00219,C00220,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00046(SSZ(2),SSZ(1))
      REAL C00219(SSZ(2),SSZ(1))
      REAL C00220(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VOW"'
      CurrentAction2=
     *  'at line 4121 in the TAB file'
      CurrentIGNO=997
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VOW"',
     *  'at line 4121 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00220(SSMP(SSMPST(2)-1+I00001),I00002)=C00046(SSMP(SSMPST(2)-1+
     *  I00001),I00002)*C00219(SSMP(SSMPST(2)-1+I00001),I00002)+RS1
    1 CONTINUE  ! END (all,i,NMRG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VOW"',
     *  'at line 4121 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00220,C00221,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00220(SSZ(2),SSZ(1))
      REAL C00221(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VWOW"'
      CurrentAction2=
     *  'at line 4126 in the TAB file'
      CurrentIGNO=999
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VWOW"',
     *  'at line 4126 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 2 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00220(I00001,I00002)
    2 CONTINUE  ! END SUM(r,REG
      C00221(I00001)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VWOW"',
     *  'at line 4126 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00044,C00048,C00050,C00222,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00222(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VWOU"'
      CurrentAction2=
     *  'at line 4131 in the TAB file'
      CurrentIGNO=1001
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VWOU"',
     *  'at line 4131 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 2 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=RS2+C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      RS1=RS1+C00050(I00001,I00003)+C00048(I00001,I00003)+RS2
    2 CONTINUE  ! END SUM(s,REG
      C00222(I00001)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VWOU"',
     *  'at line 4131 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00043,C00082,C00175,C00210,C00212,C00223,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00082(SSZ(1))
      REAL C00175(SSZ(1))
      REAL C00210(SSZ(1))
      REAL C00212(SSZ(1))
      REAL C00223(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TBALCTRA"'
      CurrentAction2=
     *  'at line 4418 in the TAB file'
      CurrentIGNO=1061
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TBALCTRA"',
     *  'at line 4418 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00223(I00002)=C00210(I00002)-C00212(I00002)+(C00175(I00002)-
     *  C00082(I00002))*C00043(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TBALCTRA"',
     *  'at line 4418 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00210,C00212,C00224,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00210(SSZ(1))
      REAL C00212(SSZ(1))
      REAL C00224(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TBAL"'
      CurrentAction2=
     *  'at line 4440 in the TAB file'
      CurrentIGNO=1065
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TBAL"',
     *  'at line 4440 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00224(I00002)=C00210(I00002)-C00212(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TBAL"',
     *  'at line 4440 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00010,C00013,C00016,C00019,C00024,C00026,C00225,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00225(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "TOTDEM"'
      CurrentAction2=
     *  'at line 4461 in the TAB file'
      CurrentIGNO=1069
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "TOTDEM"',
     *  'at line 4461 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00024(SSMP(SSMPST(15)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      RS2=0.0
      DO 4 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=RS2+C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)
    4 CONTINUE  ! END SUM(j,PROD_COMM
      C00225(I00001,I00002)=RS1+RS2+C00016(SSMP(SSMPST(15)-1+
     *  I00001),I00002)+C00019(SSMP(SSMPST(15)-1+I00001),I00002)+
     *  C00010(SSMP(SSMPST(15)-1+I00001),I00002)+C00013(SSMP(SSMPST(15)-
     *  1+I00001),I00002)
    1 CONTINUE  ! END (all,i,EGY_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "TOTDEM"',
     *  'at line 4461 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00052,C00226,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      REAL C00226(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "INCOMEEV"'
      CurrentAction2=
     *  'at line 4552 in the TAB file'
      CurrentIGNO=1085
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "INCOMEEV"',
     *  'at line 4552 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00226(I00002)=C00052(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "INCOMEEV"',
     *  'at line 4552 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00195,C00227,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00195(SSZ(1))
      REAL C00227(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "UTILPRIVEV"'
      CurrentAction2=
     *  'at line 4559 in the TAB file'
      CurrentIGNO=1089
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILPRIVEV"',
     *  'at line 4559 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00227(I00002)=C00195(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "UTILPRIVEV"',
     *  'at line 4559 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00196,C00228,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00196(SSZ(1))
      REAL C00228(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "UTILGOVEV"'
      CurrentAction2=
     *  'at line 4566 in the TAB file'
      CurrentIGNO=1093
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILGOVEV"',
     *  'at line 4566 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00228(I00002)=C00196(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "UTILGOVEV"',
     *  'at line 4566 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00197,C00229,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00197(SSZ(1))
      REAL C00229(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "UTILSAVEEV"'
      CurrentAction2=
     *  'at line 4573 in the TAB file'
      CurrentIGNO=1097
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILSAVEEV"',
     *  'at line 4573 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00229(I00002)=C00197(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "UTILSAVEEV"',
     *  'at line 4573 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00213')
      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(863).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'FY',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(863).NE.'n') then
      CALL S00171(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(863),
     *  C00031,C00047,C00188,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(874).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INDTAX',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(874).NE.'n') then
      CALL S00172(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(874),
     *  C00057,C00062,C00067,C00069,C00071,C00073,C00075,C00189,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(889).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILELAS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(889).NE.'n') then
      CALL S00173(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(889),
     *  C00080,C00177,C00178,C00179,C00190,C00191,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(891).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPARPRIV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(891).NE.'n') then
      CALL S00174(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(891),
     *  C00080,C00177,C00191,C00192,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(893).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPARGOV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(893).NE.'n') then
      CALL S00175(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(893),
     *  C00178,C00191,C00193,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(895).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'DPARSAVE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(895).NE.'n') then
      CALL S00176(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(895),
     *  C00179,C00191,C00194,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(897).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILPRIV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(897).NE.'n') then
      CALL S00177(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(897),
     *  C00195,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(901).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILGOV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(901).NE.'n') then
      CALL S00178(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(901),
     *  C00196,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(905).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILSAVE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(905).NE.'n') then
      CALL S00179(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(905),
     *  C00197,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(912).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDFM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(912).NE.'n') then
      CALL S00180(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(912),
     *  C00030,C00046,C00198,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(914).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDPM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(914).NE.'n') then
      CALL S00181(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(914),
     *  C00018,C00046,C00199,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(916).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDGM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(916).NE.'n') then
      CALL S00182(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(916),
     *  C00012,C00046,C00200,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(920).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRDM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(920).NE.'n') then
      CALL S00183(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(920),
     *  C00046,C00047,C00201,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(922).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRST',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(922).NE.'n') then
      CALL S00184(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(922),
     *  C00036,C00047,C00202,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(924).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRXMD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(924).NE.'n') then
      CALL S00185(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(924),
     *  C00035,C00047,C00203,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(929).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(929).NE.'n') then
      CALL S00186(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(929),
     *  C00015,C00021,C00029,C00204,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(931).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIFM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(931).NE.'n') then
      CALL S00187(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(931),
     *  C00029,C00204,C00205,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(933).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIPM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(933).NE.'n') then
      CALL S00188(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(933),
     *  C00021,C00204,C00206,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(935).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHRIGM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(935).NE.'n') then
      CALL S00189(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(935),
     *  C00015,C00204,C00207,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(938).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SHREM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(938).NE.'n') then
      CALL S00190(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(938),
     *  C00028,C00047,C00208,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(952).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXW',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(952).NE.'n') then
      CALL S00191(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(952),
     *  C00034,C00036,C00209,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(953).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXW',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(953).NE.'n') then
      CALL S00192(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(953),
     *  C00034,C00209,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(955).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWREGION',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(955).NE.'n') then
      CALL S00193(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(955),
     *  C00209,C00210,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(957).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIW',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(957).NE.'n') then
      CALL S00194(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(957),
     *  C00033,C00211,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(959).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWREGION',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(959).NE.'n') then
      CALL S00195(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(959),
     *  C00211,C00212,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(963).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VENDWREG',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(963).NE.'n') then
      CALL S00196(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(963),
     *  C00047,C00213,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(967).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VENDWWLD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(967).NE.'n') then
      CALL S00197(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(967),
     *  C00213,C00214,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(977).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GDP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(977).NE.'n') then
      CALL S00198(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(977),
     *  C00033,C00034,C00036,C00045,C00048,C00050,C00215,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(988).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWCOMMOD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(988).NE.'n') then
      CALL S00199(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(988),
     *  C00209,C00216,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(990).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VXWLD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(990).NE.'n') then
      CALL S00200(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(990),
     *  C00210,C00217,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(992).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWCOMMOD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(992).NE.'n') then
      CALL S00201(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(992),
     *  C00211,C00218,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(994).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PW_PM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(994).NE.'n') then
      CALL S00202(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(994),
     *  C00034,C00035,C00219,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(996).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOW',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(996).NE.'n') then
      CALL S00203(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(996),
     *  C00034,C00036,C00046,C00219,C00220,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(997).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VOW',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(997).NE.'n') then
      CALL S00204(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(997),
     *  C00034,C00046,C00219,C00220,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(999).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VWOW',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(999).NE.'n') then
      CALL S00205(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(999),
     *  C00220,C00221,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1001).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VWOU',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1001).NE.'n') then
      CALL S00206(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1001),
     *  C00044,C00048,C00050,C00222,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1061).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TBALCTRA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1061).NE.'n') then
      CALL S00207(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1061),
     *  C00043,C00082,C00175,C00210,C00212,C00223,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1065).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TBAL',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1065).NE.'n') then
      CALL S00208(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1065),
     *  C00210,C00212,C00224,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1069).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'TOTDEM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1069).NE.'n') then
      CALL S00209(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1069),
     *  C00010,C00013,C00016,C00019,C00024,C00026,C00225,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1085).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'INCOMEEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1085).NE.'n') then
      CALL S00210(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1085),
     *  C00052,C00226,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(1089).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILPRIVEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1089).NE.'n') then
      CALL S00211(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1089),
     *  C00195,C00227,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(1093).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILGOVEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1093).NE.'n') then
      CALL S00212(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1093),
     *  C00196,C00228,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(1097).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILSAVEEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1097).NE.'n') then
      CALL S00213(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1097),
     *  C00197,C00229,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00008')
      RETURN
      END
      SUBROUTINE S00214(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00098,C00230,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00098(SSZ(27),SSZ(1))
      REAL C00230(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VPAEV"'
      CurrentAction2=
     *  'at line 4602 in the TAB file'
      CurrentIGNO=1103
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPAEV"',
     *  'at line 4602 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      C00230(I00001,I00002)=C00098(SSMP(SSMPST(34)-1+I00001),I00002)
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VPAEV"',
     *  'at line 4602 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00230,C00231,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00230(SSZ(32),SSZ(1))
      REAL C00231(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VPAREGEV"'
      CurrentAction2=
     *  'at line 4609 in the TAB file'
      CurrentIGNO=1107
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VPAREGEV"',
     *  'at line 4609 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(32)  ! SUM(i,UP_COMM
      RS1=RS1+C00230(I00001,I00002)
    2 CONTINUE  ! END SUM(i,UP_COMM
      C00231(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VPAREGEV"',
     *  'at line 4609 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00215')
      RETURN
      END
      SUBROUTINE S00216(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00230,C00231,C00232,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00230(SSZ(32),SSZ(1))
      REAL C00231(SSZ(1))
      REAL C00232(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "CONSHREV"'
      CurrentAction2=
     *  'at line 4618 in the TAB file'
      CurrentIGNO=1109
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "CONSHREV"',
     *  'at line 4618 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RS1=C00230(I00001,I00002)
      RS2=C00231(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=32
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00232(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "CONSHREV"',
     *  'at line 4618 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00108,C00111,C00232,C00233,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00009
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00108(SSZ(32),SSZ(1))
      REAL C00111(SSZ(32),SSZ(1))
      REAL C00232(SSZ(32),SSZ(1))
      REAL C00233(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "EYEV"'
      CurrentAction2=
     *  'at line 4623 in the TAB file'
      CurrentIGNO=1111
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EYEV"',
     *  'at line 4623 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RS1=0.0
      DO 3 I00009=1,SSZ(32)  ! SUM(n,UP_COMM
      RS1=RS1+C00232(I00009,I00002)*C00108(I00009,I00002)
    3 CONTINUE  ! END SUM(n,UP_COMM
      RS2=1.0
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=32
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      RS5=0.0
      DO 4 I00009=1,SSZ(32)  ! SUM(n,UP_COMM
      RS5=RS5+C00232(I00009,I00002)*C00108(I00009,I00002)*
     *  C00111(I00009,I00002)
    4 CONTINUE  ! END SUM(n,UP_COMM
      RS6=0.0
      DO 5 I00009=1,SSZ(32)  ! SUM(n,UP_COMM
      RS6=RS6+C00232(I00009,I00002)*C00111(I00009,I00002)
    5 CONTINUE  ! END SUM(n,UP_COMM
      C00233(I00001,I00002)=RS4*(C00108(I00001,I00002)*(1.0-
     *  C00111(I00001,I00002))+RS5)+C00111(I00001,I00002)-RS6
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "EYEV"',
     *  'at line 4623 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00108,C00232,C00234,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00108(SSZ(32),SSZ(1))
      REAL C00232(SSZ(32),SSZ(1))
      REAL C00234(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "UELASPRIVEV"'
      CurrentAction2=
     *  'at line 4642 in the TAB file'
      CurrentIGNO=1114
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UELASPRIVEV"',
     *  'at line 4642 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(32)  ! SUM(i,UP_COMM
      RS1=RS1+C00232(I00001,I00002)*C00108(I00001,I00002)
    2 CONTINUE  ! END SUM(i,UP_COMM
      C00234(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "UELASPRIVEV"',
     *  'at line 4642 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00108,C00232,C00234,C00235,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00108(SSZ(32),SSZ(1))
      REAL C00232(SSZ(32),SSZ(1))
      REAL C00234(SSZ(1))
      REAL C00235(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "XWCONSHREV"'
      CurrentAction2=
     *  'at line 4653 in the TAB file'
      CurrentIGNO=1117
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XWCONSHREV"',
     *  'at line 4653 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RS1=C00232(I00001,I00002)*C00108(I00001,I00002)
      RS2=C00234(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=32
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00235(I00001,I00002)=RS3
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "XWCONSHREV"',
     *  'at line 4653 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00051,C00236,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00051(SSZ(1))
      REAL C00236(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "PRIVEXPEV"'
      CurrentAction2=
     *  'at line 4678 in the TAB file'
      CurrentIGNO=1121
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "PRIVEXPEV"',
     *  'at line 4678 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00236(I00002)=C00051(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "PRIVEXPEV"',
     *  'at line 4678 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00049,C00237,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00049(SSZ(1))
      REAL C00237(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "GOVEXPEV"'
      CurrentAction2=
     *  'at line 4689 in the TAB file'
      CurrentIGNO=1125
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "GOVEXPEV"',
     *  'at line 4689 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00237(I00002)=C00049(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "GOVEXPEV"',
     *  'at line 4689 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00009,C00238,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00238(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SAVEEV"'
      CurrentAction2=
     *  'at line 4697 in the TAB file'
      CurrentIGNO=1129
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SAVEEV"',
     *  'at line 4697 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00238(I00002)=C00009(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SAVEEV"',
     *  'at line 4697 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00226,C00236,C00239,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00226(SSZ(1))
      REAL C00236(SSZ(1))
      REAL C00239(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "XSHRPRIVEV"'
      CurrentAction2=
     *  'at line 4705 in the TAB file'
      CurrentIGNO=1133
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRPRIVEV"',
     *  'at line 4705 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00236(I00002)
      RS2=C00226(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00239(I00002)=RS3
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "XSHRPRIVEV"',
     *  'at line 4705 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00226,C00237,C00240,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00226(SSZ(1))
      REAL C00237(SSZ(1))
      REAL C00240(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "XSHRGOVEV"'
      CurrentAction2=
     *  'at line 4711 in the TAB file'
      CurrentIGNO=1135
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRGOVEV"',
     *  'at line 4711 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00237(I00002)
      RS2=C00226(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00240(I00002)=RS3
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "XSHRGOVEV"',
     *  'at line 4711 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00226,C00238,C00241,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00226(SSZ(1))
      REAL C00238(SSZ(1))
      REAL C00241(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "XSHRSAVEEV"'
      CurrentAction2=
     *  'at line 4716 in the TAB file'
      CurrentIGNO=1137
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "XSHRSAVEEV"',
     *  'at line 4716 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00238(I00002)
      RS2=C00226(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00241(I00002)=RS3
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "XSHRSAVEEV"',
     *  'at line 4716 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00191,C00242,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      LOGICAL ECHO1
      REAL C00191(SSZ(1))
      REAL C00242(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "UTILELASEV"'
      CurrentAction2=
     *  'at line 4761 in the TAB file'
      CurrentIGNO=1146
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "UTILELASEV"',
     *  'at line 4761 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      C00242(I00002)=C00191(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "UTILELASEV"',
     *  'at line 4761 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00052,C00191,C00226,C00242,C00243,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      REAL C00191(SSZ(1))
      REAL C00226(SSZ(1))
      REAL C00242(SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "EVSCALFACT"'
      CurrentAction2=
     *  'at line 4805 in the TAB file'
      CurrentIGNO=1155
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "EVSCALFACT"',
     *  'at line 4805 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00242(I00002)
      RS2=C00191(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      RS4=C00226(I00002)
      RS5=C00052(I00002)
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=2
         NumActiveInd=1
         ErrorRVal1=RS4
         ErrorRVal2=RS5
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      C00243(I00002)=RS3*RS6
    1 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "EVSCALFACT"',
     *  'at line 4805 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00162,C00244,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00244(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTMD"'
      CurrentAction2=
     *  'at line 4810 in the TAB file'
      CurrentIGNO=1157
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTMD"',
     *  'at line 4810 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)  ! SUM(r,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00162(I00005,I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(r,REG
      C00244(I00005,I00003)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTMD"',
     *  'at line 4810 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00036,C00245,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      INTEGER I00010
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00245(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SX_IR"'
      CurrentAction2=
     *  'at line 5275 in the TAB file'
      CurrentIGNO=1248
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IR"',
     *  'at line 5275 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      RS2=0.0
      DO 5 I00003=1,SSZ(1)  ! SUM(s,REG
      RS3=0.0
      DO 4 I00008=1,SSZ(2)  ! SUM(k,TRAD_COMM
      RS3=RS3+C00034(I00008,I00002,I00003)
    4 CONTINUE  ! END SUM(k,TRAD_COMM
      RS2=RS2+RS3
    5 CONTINUE  ! END SUM(s,REG
      RS4=0.0
      DO 6 I00010=1,SSZ(3)  ! SUM(l,MARG_COMM
      RS4=RS4+C00036(I00010,I00002)
    6 CONTINUE  ! END SUM(l,MARG_COMM
      RS5=RS1+C00036(I00005,I00002)
      RS6=RS2+RS4
      IF(RS6.NE.0.0) THEN
        RS7=RS5/RS6
      ELSE
        RS7=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS5
         ErrorRVal2=RS6
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00245(SSMP(SSMPST(1)-1+I00005),I00002)=RS7
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SX_IR"',
     *  'at line 5275 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00036,C00245,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      INTEGER I00010
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00245(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SX_IR"'
      CurrentAction2=
     *  'at line 5280 in the TAB file'
      CurrentIGNO=1249
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IR"',
     *  'at line 5280 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      RS2=0.0
      DO 5 I00003=1,SSZ(1)  ! SUM(s,REG
      RS3=0.0
      DO 4 I00008=1,SSZ(2)  ! SUM(k,TRAD_COMM
      RS3=RS3+C00034(I00008,I00002,I00003)
    4 CONTINUE  ! END SUM(k,TRAD_COMM
      RS2=RS2+RS3
    5 CONTINUE  ! END SUM(s,REG
      RS4=0.0
      DO 6 I00010=1,SSZ(3)  ! SUM(l,MARG_COMM
      RS4=RS4+C00036(I00010,I00002)
    6 CONTINUE  ! END SUM(l,MARG_COMM
      RS5=RS1
      RS6=RS2+RS4
      IF(RS6.NE.0.0) THEN
        RS7=RS5/RS6
      ELSE
        RS7=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS5
         ErrorRVal2=RS6
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=4
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00245(SSMP(SSMPST(2)-1+I00001),I00002)=RS7
    1 CONTINUE  ! END (all,i,NMRG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SX_IR"',
     *  'at line 5280 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00162,C00246,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00246(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VTICOMM"'
      CurrentAction2=
     *  'at line 5288 in the TAB file'
      CurrentIGNO=1251
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VTICOMM"',
     *  'at line 5288 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)  ! SUM(r,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00162(I00005,I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(r,REG
      C00246(I00005,I00003)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VTICOMM"',
     *  'at line 5288 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00246,C00247,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00246(SSZ(3),SSZ(1))
      REAL C00247(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VIWDIRALL"'
      CurrentAction2=
     *  'at line 5293 in the TAB file'
      CurrentIGNO=1253
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWDIRALL"',
     *  'at line 5293 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE  ! END SUM(r,REG
      C00247(SSMP(SSMPST(1)-1+I00005),I00003)=RS1+C00246(I00005,I00003)
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VIWDIRALL"',
     *  'at line 5293 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00247,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00247(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VIWDIRALL"'
      CurrentAction2=
     *  'at line 5295 in the TAB file'
      CurrentIGNO=1254
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWDIRALL"',
     *  'at line 5295 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE  ! END SUM(r,REG
      C00247(SSMP(SSMPST(2)-1+I00001),I00003)=RS1
    1 CONTINUE  ! END (all,i,NMRG_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VIWDIRALL"',
     *  'at line 5295 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00247,C00248,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00247(SSZ(2),SSZ(1))
      REAL C00248(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "VIWDATOT"'
      CurrentAction2=
     *  'at line 5300 in the TAB file'
      CurrentIGNO=1256
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "VIWDATOT"',
     *  'at line 5300 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00247(I00001,I00003)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00248(I00003)=RS1
    1 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "VIWDATOT"',
     *  'at line 5300 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00247,C00248,C00249,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00247(SSZ(2),SSZ(1))
      REAL C00248(SSZ(1))
      REAL C00249(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SM_IR"'
      CurrentAction2=
     *  'at line 5305 in the TAB file'
      CurrentIGNO=1258
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SM_IR"',
     *  'at line 5305 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00247(I00001,I00003)
      RS2=C00248(I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='s           '
         ErrorIndVal(2)=I00003
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00249(I00001,I00003)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SM_IR"',
     *  'at line 5305 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00036,C00250,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00250(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SX_IRS"'
      CurrentAction2=
     *  'at line 5311 in the TAB file'
      CurrentIGNO=1261
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IRS"',
     *  'at line 5311 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)  ! SUM(k,REG
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00008)
    3 CONTINUE  ! END SUM(k,REG
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      RS2=C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      RS3=RS1+C00036(I00005,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
         ErrorIndName(3)='s           '
         ErrorIndVal(3)=I00003
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00250(SSMP(SSMPST(1)-1+I00005),I00002,I00003)=RS4
    4 CONTINUE  ! END (all,s,REG)
    2 CONTINUE  ! END (all,r,REG)
    1 CONTINUE  ! END (all,m,MARG_COMM)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SX_IRS"',
     *  'at line 5311 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00250,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00250(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SX_IRS"'
      CurrentAction2=
     *  'at line 5313 in the TAB file'
      CurrentIGNO=1262
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SX_IRS"',
     *  'at line 5313 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)  ! SUM(k,REG
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00008)
    3 CONTINUE  ! END SUM(k,REG
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      RS2=C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE IF(RS2.EQ.0.0) THEN
        RS4=ZDZVAL
        NZDZ=NZDZ+1
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=4
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=4
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
         ErrorIndName(3)='s           '
         ErrorIndVal(3)=I00003
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00250(SSMP(SSMPST(2)-1+I00001),I00002,I00003)=RS4
    4 CONTINUE  ! END (all,s,REG)
    2 CONTINUE  ! END (all,r,REG)
    1 CONTINUE  ! END (all,i,NMRG_COMM)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SX_IRS"',
     *  'at line 5313 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00036,C00251,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00005
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00251(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SXT_IR"'
      CurrentAction2=
     *  'at line 5319 in the TAB file'
      CurrentIGNO=1265
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SXT_IR"',
     *  'at line 5319 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)  ! SUM(k,REG
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00008)
    3 CONTINUE  ! END SUM(k,REG
      RS2=C00036(I00005,I00002)
      RS3=RS1+C00036(I00005,I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00251(I00005,I00002)=RS4
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SXT_IR"',
     *  'at line 5319 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00247,C00252,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00247(SSZ(2),SSZ(1))
      REAL C00252(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SM_IRS"'
      CurrentAction2=
     *  'at line 5336 in the TAB file'
      CurrentIGNO=1270
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SM_IRS"',
     *  'at line 5336 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=C00034(I00001,I00002,I00003)
      RS2=C00247(I00001,I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=2
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
         ErrorIndName(3)='s           '
         ErrorIndVal(3)=I00003
         ErrorIndSetNo(3)=1
        END IF
      END IF
      C00252(I00001,I00002,I00003)=RS3
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SM_IRS"',
     *  'at line 5336 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00246,C00247,C00253,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00003
      INTEGER I00005
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00246(SSZ(3),SSZ(1))
      REAL C00247(SSZ(2),SSZ(1))
      REAL C00253(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SMT_IR"'
      CurrentAction2=
     *  'at line 5341 in the TAB file'
      CurrentIGNO=1272
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SMT_IR"',
     *  'at line 5341 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=C00246(I00005,I00003)
      RS2=C00247(SSMP(SSMPST(1)-1+I00005),I00003)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='s           '
         ErrorIndVal(2)=I00003
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00253(I00005,I00003)=RS3
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,s,REG)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SMT_IR"',
     *  'at line 5341 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00036,C00254,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00254(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SW_IR"'
      CurrentAction2=
     *  'at line 5358 in the TAB file'
      CurrentIGNO=1277
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_IR"',
     *  'at line 5358 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 2 I00008=1,SSZ(1)  ! SUM(k,REG
      RS2=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=RS2+C00034(SSMP(SSMPST(1)-1+I00005),I00008,I00003)
    3 CONTINUE  ! END SUM(s,REG
      RS1=RS1+RS2+C00036(I00005,I00008)
    2 CONTINUE  ! END SUM(k,REG
      DO 4 I00002=1,SSZ(1)  ! (all,r,REG)
      RS3=0.0
      DO 5 I00003=1,SSZ(1)  ! SUM(s,REG
      RS3=RS3+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    5 CONTINUE  ! END SUM(s,REG
      RS4=RS3+C00036(I00005,I00002)
      RS5=RS1
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS4
         ErrorRVal2=RS5
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00254(SSMP(SSMPST(1)-1+I00005),I00002)=RS6
    4 CONTINUE  ! END (all,r,REG)
    1 CONTINUE  ! END (all,m,MARG_COMM)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SW_IR"',
     *  'at line 5358 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00254,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00254(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SW_IR"'
      CurrentAction2=
     *  'at line 5362 in the TAB file'
      CurrentIGNO=1278
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_IR"',
     *  'at line 5362 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      DO 1 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RS1=0.0
      DO 2 I00008=1,SSZ(1)  ! SUM(k,REG
      RS2=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=RS2+C00034(SSMP(SSMPST(2)-1+I00001),I00008,I00003)
    3 CONTINUE  ! END SUM(s,REG
      RS1=RS1+RS2
    2 CONTINUE  ! END SUM(k,REG
      DO 4 I00002=1,SSZ(1)  ! (all,r,REG)
      RS3=0.0
      DO 5 I00003=1,SSZ(1)  ! SUM(s,REG
      RS3=RS3+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    5 CONTINUE  ! END SUM(s,REG
      RS4=RS3
      RS5=RS1
      IF(RS5.NE.0.0) THEN
        RS6=RS4/RS5
      ELSE
        RS6=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS4
         ErrorRVal2=RS5
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=4
         ErrorIndName(2)='r           '
         ErrorIndVal(2)=I00002
         ErrorIndSetNo(2)=1
        END IF
      END IF
      C00254(SSMP(SSMPST(2)-1+I00001),I00002)=RS6
    4 CONTINUE  ! END (all,r,REG)
    1 CONTINUE  ! END (all,i,NMRG_COMM)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SW_IR"',
     *  'at line 5362 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00242')
      RETURN
      END
      SUBROUTINE S00243(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00034,C00036,C00255,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      INTEGER I00010
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00255(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SW_I"'
      CurrentAction2=
     *  'at line 5375 in the TAB file'
      CurrentIGNO=1282
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_I"',
     *  'at line 5375 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      RS1=0.0
      DO 1 I00008=1,SSZ(2)  ! SUM(k,TRAD_COMM
      RS2=0.0
      DO 2 I00002=1,SSZ(1)  ! SUM(r,REG
      RS3=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS3=RS3+C00034(I00008,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      RS2=RS2+RS3
    2 CONTINUE  ! END SUM(r,REG
      RS1=RS1+RS2
    1 CONTINUE  ! END SUM(k,TRAD_COMM
      RS4=0.0
      DO 4 I00010=1,SSZ(3)  ! SUM(l,MARG_COMM
      RS5=0.0
      DO 5 I00002=1,SSZ(1)  ! SUM(r,REG
      RS5=RS5+C00036(I00010,I00002)
    5 CONTINUE  ! END SUM(r,REG
      RS4=RS4+RS5
    4 CONTINUE  ! END SUM(l,MARG_COMM
      DO 6 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS6=0.0
      DO 7 I00002=1,SSZ(1)  ! SUM(r,REG
      RS7=0.0
      DO 8 I00003=1,SSZ(1)  ! SUM(s,REG
      RS7=RS7+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    8 CONTINUE  ! END SUM(s,REG
      RS6=RS6+RS7+C00036(I00005,I00002)
    7 CONTINUE  ! END SUM(r,REG
      RS8=RS6
      RS9=RS1+RS4
      IF(RS9.NE.0.0) THEN
        RS10=RS8/RS9
      ELSE
        RS10=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS8
         ErrorRVal2=RS9
         ErrorIndName(1)='m           '
         ErrorIndVal(1)=I00005
         ErrorIndSetNo(1)=3
        END IF
      END IF
      C00255(SSMP(SSMPST(1)-1+I00005))=RS10
    6 CONTINUE  ! END (all,m,MARG_COMM)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SW_I"',
     *  'at line 5375 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00036,C00255,
     *  ZDZVAL,NDZVAL,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00008
      INTEGER I00010
      REAL ZDZVAL,NDZVAL
      INTEGER NZDZ,NNDZ
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00255(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "SW_I"'
      CurrentAction2=
     *  'at line 5380 in the TAB file'
      CurrentIGNO=1283
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "SW_I"',
     *  'at line 5380 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      NZDZ=0
      NNDZ=0
      RS1=0.0
      DO 1 I00008=1,SSZ(2)  ! SUM(k,TRAD_COMM
      RS2=0.0
      DO 2 I00002=1,SSZ(1)  ! SUM(r,REG
      RS3=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS3=RS3+C00034(I00008,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      RS2=RS2+RS3
    2 CONTINUE  ! END SUM(r,REG
      RS1=RS1+RS2
    1 CONTINUE  ! END SUM(k,TRAD_COMM
      RS4=0.0
      DO 4 I00010=1,SSZ(3)  ! SUM(l,MARG_COMM
      RS5=0.0
      DO 5 I00002=1,SSZ(1)  ! SUM(r,REG
      RS5=RS5+C00036(I00010,I00002)
    5 CONTINUE  ! END SUM(r,REG
      RS4=RS4+RS5
    4 CONTINUE  ! END SUM(l,MARG_COMM
      DO 6 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RS6=0.0
      DO 7 I00002=1,SSZ(1)  ! SUM(r,REG
      RS7=0.0
      DO 8 I00003=1,SSZ(1)  ! SUM(s,REG
      RS7=RS7+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    8 CONTINUE  ! END SUM(s,REG
      RS6=RS6+RS7
    7 CONTINUE  ! END SUM(r,REG
      RS8=RS6
      RS9=RS1+RS4
      IF(RS9.NE.0.0) THEN
        RS10=RS8/RS9
      ELSE
        RS10=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS8
         ErrorRVal2=RS9
         ErrorIndName(1)='i           '
         ErrorIndVal(1)=I00001
         ErrorIndSetNo(1)=4
        END IF
      END IF
      C00255(SSMP(SSMPST(2)-1+I00001))=RS10
    6 CONTINUE  ! END (all,i,NMRG_COMM)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "SW_I"',
     *  'at line 5380 in the TAB file',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00244')
      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.
      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(1103).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPAEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1103).NE.'n') then
      CALL S00214(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1103),
     *  C00098,C00230,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(1107).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VPAREGEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1107).NE.'n') then
      CALL S00215(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1107),
     *  C00230,C00231,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1109).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'CONSHREV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1109).NE.'n') then
      CALL S00216(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1109),
     *  C00230,C00231,C00232,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1111).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EYEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1111).NE.'n') then
      CALL S00217(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1111),
     *  C00108,C00111,C00232,C00233,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1114).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UELASPRIVEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1114).NE.'n') then
      CALL S00218(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1114),
     *  C00108,C00232,C00234,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1117).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XWCONSHREV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1117).NE.'n') then
      CALL S00219(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1117),
     *  C00108,C00232,C00234,C00235,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1121).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'PRIVEXPEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1121).NE.'n') then
      CALL S00220(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1121),
     *  C00051,C00236,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(1125).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'GOVEXPEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1125).NE.'n') then
      CALL S00221(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1125),
     *  C00049,C00237,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(1129).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SAVEEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1129).NE.'n') then
      CALL S00222(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1129),
     *  C00009,C00238,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(1133).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRPRIVEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1133).NE.'n') then
      CALL S00223(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1133),
     *  C00226,C00236,C00239,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1135).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRGOVEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1135).NE.'n') then
      CALL S00224(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1135),
     *  C00226,C00237,C00240,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1137).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'XSHRSAVEEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1137).NE.'n') then
      CALL S00225(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1137),
     *  C00226,C00238,C00241,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1146).EQ.'y'.AND.(FSTPAS.OR.PRELIM)) THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'UTILELASEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(FSTPAS.OR.PRELIM) THEN
      IF(DOIG(1146).NE.'n') then
      CALL S00226(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1146),
     *  C00191,C00242,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(1155).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'EVSCALFACT',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1155).NE.'n') then
      CALL S00227(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1155),
     *  C00052,C00191,C00226,C00242,C00243,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1157).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTMD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1157).NE.'n') then
      CALL S00228(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1157),
     *  C00162,C00244,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1248).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1248).NE.'n') then
      CALL S00229(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1248),
     *  C00034,C00036,C00245,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1249).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1249).NE.'n') then
      CALL S00230(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1249),
     *  C00034,C00036,C00245,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1251).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VTICOMM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1251).NE.'n') then
      CALL S00231(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1251),
     *  C00162,C00246,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1253).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDIRALL',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1253).NE.'n') then
      CALL S00232(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1253),
     *  C00034,C00246,C00247,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1254).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDIRALL',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1254).NE.'n') then
      CALL S00233(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1254),
     *  C00034,C00247,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1256).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'VIWDATOT',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1256).NE.'n') then
      CALL S00234(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1256),
     *  C00247,C00248,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1258).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SM_IR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1258).NE.'n') then
      CALL S00235(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1258),
     *  C00247,C00248,C00249,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,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(1261).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IRS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1261).NE.'n') then
      CALL S00236(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1261),
     *  C00034,C00036,C00250,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1262).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SX_IRS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1262).NE.'n') then
      CALL S00237(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1262),
     *  C00034,C00250,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1265).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SXT_IR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1265).NE.'n') then
      CALL S00238(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1265),
     *  C00034,C00036,C00251,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1270).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SM_IRS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1270).NE.'n') then
      CALL S00239(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1270),
     *  C00034,C00247,C00252,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1272).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SMT_IR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1272).NE.'n') then
      CALL S00240(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1272),
     *  C00246,C00247,C00253,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1277).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_IR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1277).NE.'n') then
      CALL S00241(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1277),
     *  C00034,C00036,C00254,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1278).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_IR',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1278).NE.'n') then
      CALL S00242(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1278),
     *  C00034,C00254,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1282).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_I',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1282).NE.'n') then
      CALL S00243(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1282),
     *  C00034,C00036,C00255,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1283).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'SW_I',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1283).NE.'n') then
      CALL S00244(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1283),
     *  C00034,C00036,C00255,
     *  ZDZVAL,NDZVAL,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00010),C00010,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00011),C00011,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00012),C00012,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00013),C00013,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00014),C00014,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00015),C00015,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00016),C00016,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00017),C00017,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00018),C00018,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00019),C00019,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00020),C00020,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00021),C00021,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00022),C00022,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00023),C00023,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00024),C00024,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00025),C00025,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00026),C00026,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00027),C00027,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00028),C00028,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00029),C00029,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00030),C00030,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00031),C00031,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00032),C00032,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00033),C00033,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00034),C00034,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00035),C00035,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00036),C00036,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00037),C00037,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00038),C00038,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00039),C00039,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00040),C00040,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00041),C00041,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00042),C00042,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,OVOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(C00155),C00155,
     *  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(C00162),C00162,
     *  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(C00175),C00175,
     *  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
      RETURN
15000 CALL PERET('M00009')
      RETURN
      END
      SUBROUTINE S00245(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00048,C00087,C00089,C00090,C00256,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00256(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00256"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1301
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00256"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-C00048(I00001,I00002)*(-C00090(I00001,I00002)*100.0 *
     *  C00089(I00001,I00002)-(1  -C00090(I00001,I00002))*100.0 *
     *  C00087(I00001,I00002))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00256(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00256"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00065,C00076,C00087,C00089,C00090,C00257,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00257(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00257"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1303
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00257"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-C00065(I00001,I00002)*(C00076(I00001)*100.0 *
     *  C00089(I00001,I00002)+C00076(I00001)*(-C00090(I00001,I00002)*
     *  100.0 *C00089(I00001,I00002)-(1  -C00090(I00001,I00002))*100.0 *
     *  C00087(I00001,I00002)))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00257(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00257"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00065,C00066,C00076,C00087,C00089,C00090,C00243,C00258,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00258(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00258"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1305
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00258"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-(C00065(I00001,I00002)+C00066(I00001,I00002))*
     *  (C00076(I00001)*100.0 *C00089(I00001,I00002)+C00076(I00001)*(-
     *  C00090(I00001,I00002)*100.0 *C00089(I00001,I00002)-(1  -
     *  C00090(I00001,I00002))*100.0 *C00087(I00001,I00002)))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00258(I00002)=-0.01  *C00243(I00002)*RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00258"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00031,C00045,C00053,C00054,C00055,C00056,C00058,C00059,
     *  C00060,C00061,C00063,C00064,C00065,C00066,C00068,C00070,
     *  C00072,C00074,C00226,C00243,C00259,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15,RS16
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00226(SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00259(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00259"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1307
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00259"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(9)  ! SUM(i,NSAV_COMM
      RS1=RS1-C00070(I00001,I00002)
    2 CONTINUE  ! END SUM(i,NSAV_COMM
      RS2=0.0
      DO 4 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS3=0.0
      DO 3 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      RS3=RS3-C00068(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(i,ENDW_COMM
      RS2=RS2+RS3
    4 CONTINUE  ! END SUM(j,PROD_COMM
      RS4=0.0
      DO 5 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS5=0.0
      DO 6 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS5=RS5-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))
    6 CONTINUE  ! END SUM(i,TRAD_COMM
      RS4=RS4+RS5
    5 CONTINUE  ! END SUM(j,PROD_COMM
      RS6=0.0
      DO 7 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS7=0.0
      DO 8 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS7=RS7-(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))
    8 CONTINUE  ! END SUM(i,TRAD_COMM
      RS6=RS6+RS7
    7 CONTINUE  ! END SUM(j,PROD_COMM
      RS8=0.0
      DO 9 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS8=RS8-(C00060(I00001,I00002)+C00061(I00001,I00002))
    9 CONTINUE  ! END SUM(i,TRAD_COMM
      RS9=0.0
      DO 10 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS9=RS9-(C00058(I00001,I00002)+C00059(I00001,I00002))
   10 CONTINUE  ! END SUM(i,TRAD_COMM
      RS10=0.0
      DO 11 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS10=RS10-(C00065(I00001,I00002)+C00066(I00001,I00002))
   11 CONTINUE  ! END SUM(i,TRAD_COMM
      RS11=0.0
      DO 12 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS11=RS11-(C00063(I00001,I00002)+C00064(I00001,I00002))
   12 CONTINUE  ! END SUM(i,TRAD_COMM
      RS12=0.0
      DO 14 I00003=1,SSZ(1)  ! SUM(s,REG
      RS13=0.0
      DO 13 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS13=RS13-C00072(I00001,I00002,I00003)
   13 CONTINUE  ! END SUM(i,TRAD_COMM
      RS12=RS12+RS13
   14 CONTINUE  ! END SUM(s,REG
      RS14=0.0
      DO 16 I00003=1,SSZ(1)  ! SUM(s,REG
      RS15=0.0
      DO 15 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS15=RS15-C00074(I00001,I00003,I00002)
   15 CONTINUE  ! END SUM(i,TRAD_COMM
      RS14=RS14+RS15
   16 CONTINUE  ! END SUM(s,REG
      RS16=0.0
      DO 17 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      RS16=RS16-C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00002)
   17 CONTINUE  ! END SUM(i,ENDW_COMM
      C00259(I00002)=-(0.01  *C00243(I00002)*(RS1+RS2+RS4+RS6+RS8+RS9+
     *  RS10+RS11+RS12+RS14+RS16+C00031(I00002))+0.01  *C00226(I00002))
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00259"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00065,C00066,C00076,C00087,C00089,C00090,C00243,C00260,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00260(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00260"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1309
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00260"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00243(I00002)*(C00076(I00001)*100.0 *C00089(I00001,I00002)+
     *  C00076(I00001)*(-C00090(I00001,I00002)*100.0 *
     *  C00089(I00001,I00002)-(1  -C00090(I00001,I00002))*100.0 *
     *  C00087(I00001,I00002)))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00260(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00260"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00065,C00066,C00243,C00261,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00261(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00261"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1311
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00261"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00243(I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00261(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00261"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00053,C00054,C00055,C00056,C00058,C00059,C00060,C00061,
     *  C00063,C00064,C00065,C00066,C00068,C00070,C00072,C00074,
     *  C00243,C00262,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12,RS13,RS14
      REAL RS15
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00262(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00262"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1313
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00262"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(9)  ! SUM(i,NSAV_COMM
      RS1=RS1-C00070(I00001,I00002)
    2 CONTINUE  ! END SUM(i,NSAV_COMM
      RS2=0.0
      DO 4 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS3=0.0
      DO 3 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      RS3=RS3-C00068(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(i,ENDW_COMM
      RS2=RS2+RS3
    4 CONTINUE  ! END SUM(j,PROD_COMM
      RS4=0.0
      DO 5 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS5=0.0
      DO 6 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS5=RS5-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))
    6 CONTINUE  ! END SUM(i,TRAD_COMM
      RS4=RS4+RS5
    5 CONTINUE  ! END SUM(j,PROD_COMM
      RS6=0.0
      DO 7 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS7=0.0
      DO 8 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS7=RS7-(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))
    8 CONTINUE  ! END SUM(i,TRAD_COMM
      RS6=RS6+RS7
    7 CONTINUE  ! END SUM(j,PROD_COMM
      RS8=0.0
      DO 9 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS8=RS8-(C00060(I00001,I00002)+C00061(I00001,I00002))
    9 CONTINUE  ! END SUM(i,TRAD_COMM
      RS9=0.0
      DO 10 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS9=RS9-(C00058(I00001,I00002)+C00059(I00001,I00002))
   10 CONTINUE  ! END SUM(i,TRAD_COMM
      RS10=0.0
      DO 11 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS10=RS10-(C00065(I00001,I00002)+C00066(I00001,I00002))
   11 CONTINUE  ! END SUM(i,TRAD_COMM
      RS11=0.0
      DO 12 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS11=RS11-(C00063(I00001,I00002)+C00064(I00001,I00002))
   12 CONTINUE  ! END SUM(i,TRAD_COMM
      RS12=0.0
      DO 14 I00003=1,SSZ(1)  ! SUM(s,REG
      RS13=0.0
      DO 13 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS13=RS13-C00072(I00001,I00002,I00003)
   13 CONTINUE  ! END SUM(i,TRAD_COMM
      RS12=RS12+RS13
   14 CONTINUE  ! END SUM(s,REG
      RS14=0.0
      DO 16 I00003=1,SSZ(1)  ! SUM(s,REG
      RS15=0.0
      DO 15 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS15=RS15-C00074(I00001,I00003,I00002)
   15 CONTINUE  ! END SUM(i,TRAD_COMM
      RS14=RS14+RS15
   16 CONTINUE  ! END SUM(s,REG
      C00262(I00002)=-0.01  *C00243(I00002)*(RS1+RS2+RS4+RS6+RS8+RS9+
     *  RS10+RS11+RS12+RS14)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00262"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00053,C00054,C00055,C00056,C00058,C00059,C00060,C00061,
     *  C00063,C00064,C00065,C00066,C00070,C00072,C00074,C00243,
     *  C00263,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00263(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00263"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1315
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00263"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      RS2=0.0
      DO 4 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=RS2-(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))
    4 CONTINUE  ! END SUM(j,PROD_COMM
      RS3=0.0
      DO 5 I00003=1,SSZ(1)  ! SUM(s,REG
      RS3=RS3-C00072(I00001,I00002,I00003)
    5 CONTINUE  ! END SUM(s,REG
      RS4=0.0
      DO 6 I00003=1,SSZ(1)  ! SUM(s,REG
      RS4=RS4-C00074(I00001,I00003,I00002)
    6 CONTINUE  ! END SUM(s,REG
      C00263(I00001,I00002)=-0.01  *C00243(I00002)*(-
     *  C00070(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+RS1+
     *  RS2-(C00060(I00001,I00002)+C00061(I00001,I00002))-
     *  (C00058(I00001,I00002)+C00059(I00001,I00002))-
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))-
     *  (C00063(I00001,I00002)+C00064(I00001,I00002))+RS3+RS4)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00263"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00060,C00076,C00103,C00264,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00264(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00264"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1317
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00264"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-C00060(I00001,I00002)*C00076(I00001)*100.0 *
     *  C00103(I00001,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00264(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00264"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00060,C00061,C00076,C00103,C00243,C00258,C00265,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00258(SSZ(1))
      REAL C00265(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00265"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1319
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00265"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*100.0 *
     *  C00103(I00001,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00265(I00002)=RS1+C00258(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00265"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00060,C00061,C00076,C00103,C00243,C00266,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00266(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00266"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1321
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00266"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*100.0 *C00103(I00001,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00266(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00266"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00060,C00061,C00243,C00267,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00267(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00267"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1323
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00267"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00267(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00267"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00060,C00076,C00101,C00103,C00104,C00264,C00268,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00264(SSZ(1))
      REAL C00268(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00268"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1325
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00268"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00060(I00001,I00002)*C00076(I00001)*(-
     *  C00104(I00001,I00002)*100.0 *C00103(I00001,I00002)-(1  -
     *  C00104(I00001,I00002))*100.0 *C00101(I00001,I00002))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00268(I00002)=C00264(I00002)+RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00268"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00050,C00101,C00103,C00104,C00256,C00269,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00256(SSZ(1))
      REAL C00269(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00269"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1327
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00269"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00050(I00001,I00002)*(-C00104(I00001,I00002)*100.0 *
     *  C00103(I00001,I00002)-(1  -C00104(I00001,I00002))*100.0 *
     *  C00101(I00001,I00002))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00269(I00002)=C00256(I00002)+RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00269"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00060,C00061,C00076,C00101,C00103,C00104,C00243,C00265,
     *  C00270,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00265(SSZ(1))
      REAL C00270(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00270"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1329
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00270"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*(-C00104(I00001,I00002)*
     *  100.0 *C00103(I00001,I00002)-(1  -C00104(I00001,I00002))*100.0 *
     *  C00101(I00001,I00002))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00270(I00002)=C00265(I00002)+RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00270"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00060,C00061,C00076,C00101,C00103,C00104,C00243,C00266,
     *  C00271,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00266(SSZ(1))
      REAL C00271(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00271"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1331
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00271"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*(-C00104(I00001,I00002)*100.0 *
     *  C00103(I00001,I00002)-(1  -C00104(I00001,I00002))*100.0 *
     *  C00101(I00001,I00002))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      C00271(I00002)=C00266(I00002)+RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00271"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00010,C00013,C00016,C00019,C00024,C00076,C00086,C00090,
     *  C00100,C00104,C00119,C00272,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00272(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00272"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1333
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00272"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RS1=-C00010(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00086(SSMP(SSMPST(15)-1+I00001),I00002)-C00013(SSMP(SSMPST(15)-
     *  1+I00001),I00002)*C00076(SSMP(SSMPST(15)-1+I00001))*(1  -
     *  C00090(SSMP(SSMPST(15)-1+I00001),I00002))*
     *  C00086(SSMP(SSMPST(15)-1+I00001),I00002)-C00016(SSMP(SSMPST(15)-
     *  1+I00001),I00002)*C00100(SSMP(SSMPST(15)-1+I00001),I00002)
      RS2=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=RS2-C00024(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00119(SSMP(SSMPST(15)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00272(I00001,I00002)=RS1-C00019(SSMP(SSMPST(15)-1+
     *  I00001),I00002)*C00076(SSMP(SSMPST(15)-1+I00001))*(1  -
     *  C00104(SSMP(SSMPST(15)-1+I00001),I00002))*
     *  C00100(SSMP(SSMPST(15)-1+I00001),I00002)+RS2
    1 CONTINUE  ! END (all,i,EGY_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00272"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00010,C00013,C00016,C00019,C00024,C00076,C00087,C00089,
     *  C00090,C00101,C00103,C00104,C00120,C00273,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00273(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00273"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1335
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00273"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-C00024(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*100.0 *
     *  C00120(SSMP(SSMPST(15)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      RS2=C00013(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*100.0 *
     *  C00089(SSMP(SSMPST(15)-1+I00001),I00002)+C00076(SSMP(SSMPST(15)-
     *  1+I00001))*(-C00090(SSMP(SSMPST(15)-1+I00001),I00002)*100.0 *
     *  C00089(SSMP(SSMPST(15)-1+I00001),I00002)-(1  -
     *  C00090(SSMP(SSMPST(15)-1+I00001),I00002))*100.0 *
     *  C00087(SSMP(SSMPST(15)-1+I00001),I00002)))
      RS3=RS1+C00019(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*100.0 *C00103(SSMP(SSMPST(15)-
     *  1+I00001),I00002)-C00019(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  100.0 *C00103(SSMP(SSMPST(15)-1+I00001),I00002)-
     *  C00016(SSMP(SSMPST(15)-1+I00001),I00002)*100.0 *
     *  C00101(SSMP(SSMPST(15)-1+I00001),I00002)+RS2
      RS4=C00019(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*(-C00104(SSMP(SSMPST(15)-1+
     *  I00001),I00002)*100.0 *C00103(SSMP(SSMPST(15)-1+I00001),I00002)-
     *  (1  -C00104(SSMP(SSMPST(15)-1+I00001),I00002))*100.0 *
     *  C00101(SSMP(SSMPST(15)-1+I00001),I00002))
      C00273(I00001,I00002)=RS3-C00013(SSMP(SSMPST(15)-1+
     *  I00001),I00002)*100.0 *C00089(SSMP(SSMPST(15)-1+I00001),I00002)-
     *  C00010(SSMP(SSMPST(15)-1+I00001),I00002)*100.0 *
     *  C00087(SSMP(SSMPST(15)-1+I00001),I00002)+RS4
    1 CONTINUE  ! END (all,i,EGY_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00273"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00013,C00019,C00026,C00076,C00088,C00090,C00102,C00104,
     *  C00121,C00274,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00274(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00274"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1337
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00274"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RS1=C00013(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*C00088(SSMP(SSMPST(15)-1+
     *  I00001),I00002)-C00076(SSMP(SSMPST(15)-1+I00001))*
     *  C00090(SSMP(SSMPST(15)-1+I00001),I00002)*C00088(SSMP(SSMPST(15)-
     *  1+I00001),I00002))-C00013(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00088(SSMP(SSMPST(15)-1+I00001),I00002)-C00019(SSMP(SSMPST(15)-
     *  1+I00001),I00002)*C00102(SSMP(SSMPST(15)-1+I00001),I00002)
      RS2=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=RS2-C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00121(SSMP(SSMPST(15)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00274(I00001,I00002)=RS1+C00019(SSMP(SSMPST(15)-1+
     *  I00001),I00002)*C00076(SSMP(SSMPST(15)-1+I00001))*
     *  C00102(SSMP(SSMPST(15)-1+I00001),I00002)-C00019(SSMP(SSMPST(15)-
     *  1+I00001),I00002)*C00076(SSMP(SSMPST(15)-1+I00001))*
     *  C00104(SSMP(SSMPST(15)-1+I00001),I00002)*C00102(SSMP(SSMPST(15)-
     *  1+I00001),I00002)+RS2
    1 CONTINUE  ! END (all,i,EGY_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00274"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00026,C00122,C00273,C00275,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00273(SSZ(15),SSZ(1))
      REAL C00275(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00275"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1339
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00275"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*100.0 *
     *  C00122(SSMP(SSMPST(15)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00275(I00001,I00002)=RS1+C00273(I00001,I00002)
    1 CONTINUE  ! END (all,i,EGY_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00275"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00044,C00048,C00050,C00086,C00090,C00100,C00104,C00119,
     *  C00123,C00276,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00276(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00276"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1341
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00276"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)*(1  -
     *  C00123(I00001,I00004,I00003))*C00119(I00001,I00004,I00003)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00276(I00001,I00003)=-C00048(I00001,I00003)*(1  -
     *  C00090(I00001,I00003))*C00086(I00001,I00003)-
     *  C00050(I00001,I00003)*(1  -C00104(I00001,I00003))*
     *  C00100(I00001,I00003)+RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00276"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00044,C00048,C00050,C00088,C00090,C00102,C00104,C00121,
     *  C00123,C00277,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00277(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00277"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1343
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00277"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)*
     *  C00123(I00001,I00004,I00003)*C00121(I00001,I00004,I00003)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00277(I00001,I00003)=-C00048(I00001,I00003)*
     *  C00090(I00001,I00003)*C00088(I00001,I00003)-
     *  C00050(I00001,I00003)*C00104(I00001,I00003)*
     *  C00102(I00001,I00003)+RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00277"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00044,C00048,C00050,C00087,C00089,C00090,C00101,C00103,
     *  C00104,C00120,C00122,C00123,C00278,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00278(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00278"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1345
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00278"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)*(-
     *  C00123(I00001,I00004,I00003)*100.0 *
     *  C00122(I00001,I00004,I00003)-(1  -C00123(I00001,I00004,I00003))*
     *  100.0 *C00120(I00001,I00004,I00003))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00278(I00001,I00003)=C00048(I00001,I00003)*(-
     *  C00090(I00001,I00003)*100.0 *C00089(I00001,I00003)-(1  -
     *  C00090(I00001,I00003))*100.0 *C00087(I00001,I00003))+
     *  C00050(I00001,I00003)*(-C00104(I00001,I00003)*100.0 *
     *  C00103(I00001,I00003)-(1  -C00104(I00001,I00003))*100.0 *
     *  C00101(I00001,I00003))+RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00278"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00053,C00055,C00076,C00119,C00123,C00279,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00279(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00279"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1347
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00279"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00053(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      RS2=0.0
      DO 4 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=RS2+C00055(I00001,I00004,I00002)*C00076(I00001)*(1  -
     *  C00123(I00001,I00004,I00002))*C00119(I00001,I00004,I00002)
    4 CONTINUE  ! END SUM(j,PROD_COMM
      C00279(I00001,I00002)=-(RS1+RS2)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00279"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00076,C00121,C00123,C00280,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00280(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00280"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1349
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00280"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00055(I00001,I00004,I00002)*(1.0-(C00076(I00001)*
     *  C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002)))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00280(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00280"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00076,C00120,C00122,C00123,C00281,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00281(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00281"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1351
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00281"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-C00055(I00001,I00004,I00002)*(C00076(I00001)*100.0 *
     *  C00122(I00001,I00004,I00002)+C00076(I00001)*(-
     *  C00123(I00001,I00004,I00002)*100.0 *
     *  C00122(I00001,I00004,I00002)-(1  -C00123(I00001,I00004,I00002))*
     *  100.0 *C00120(I00001,I00004,I00002)))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00281(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00281"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00076,C00086,C00090,C00100,C00104,C00119,C00123,C00205,
     *  C00206,C00207,C00282,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00205(SSZ(2),SSZ(7),SSZ(1))
      REAL C00206(SSZ(2),SSZ(1))
      REAL C00207(SSZ(2),SSZ(1))
      REAL C00282(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00282"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1353
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00282"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-C00205(I00001,I00004,I00002)*C00076(I00001)*(1  -
     *  C00123(I00001,I00004,I00002))*C00119(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00282(I00001,I00002)=-C00207(I00001,I00002)*C00076(I00001)*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)-
     *  C00206(I00001,I00002)*C00076(I00001)*(1  -
     *  C00104(I00001,I00002))*C00100(I00001,I00002)+RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00282"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00076,C00088,C00090,C00102,C00104,C00121,C00123,C00205,
     *  C00206,C00207,C00283,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00205(SSZ(2),SSZ(7),SSZ(1))
      REAL C00206(SSZ(2),SSZ(1))
      REAL C00207(SSZ(2),SSZ(1))
      REAL C00283(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00283"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1355
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00283"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00205(I00001,I00004,I00002)*(C00076(I00001)*
     *  C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00283(I00001,I00002)=C00207(I00001,I00002)*(C00076(I00001)*
     *  C00088(I00001,I00002)-C00076(I00001)*C00090(I00001,I00002)*
     *  C00088(I00001,I00002))+C00206(I00001,I00002)*C00076(I00001)*
     *  C00102(I00001,I00002)-C00206(I00001,I00002)*C00076(I00001)*
     *  C00104(I00001,I00002)*C00102(I00001,I00002)+RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00283"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00076,C00087,C00089,C00090,C00101,C00103,C00104,C00120,
     *  C00122,C00123,C00205,C00206,C00207,C00284,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00205(SSZ(2),SSZ(7),SSZ(1))
      REAL C00206(SSZ(2),SSZ(1))
      REAL C00207(SSZ(2),SSZ(1))
      REAL C00284(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00284"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1357
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00284"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00205(I00001,I00004,I00002)*(C00076(I00001)*100.0 *
     *  C00122(I00001,I00004,I00002)+C00076(I00001)*(-
     *  C00123(I00001,I00004,I00002)*100.0 *
     *  C00122(I00001,I00004,I00002)-(1  -C00123(I00001,I00004,I00002))*
     *  100.0 *C00120(I00001,I00004,I00002)))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00284(I00001,I00002)=RS1+C00206(I00001,I00002)*C00076(I00001)*
     *  100.0 *C00103(I00001,I00002)+C00207(I00001,I00002)*
     *  (C00076(I00001)*100.0 *C00089(I00001,I00002)+C00076(I00001)*(-
     *  C00090(I00001,I00002)*100.0 *C00089(I00001,I00002)-(1  -
     *  C00090(I00001,I00002))*100.0 *C00087(I00001,I00002)))+
     *  C00206(I00001,I00002)*C00076(I00001)*(-C00104(I00001,I00002)*
     *  100.0 *C00103(I00001,I00002)-(1  -C00104(I00001,I00002))*100.0 *
     *  C00101(I00001,I00002))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00284"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00026,C00076,C00119,C00123,C00272,C00285,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00272(SSZ(15),SSZ(1))
      REAL C00285(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00285"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1359
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00285"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*(1  -C00123(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002))*C00119(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00285(I00001,I00002)=C00272(I00001,I00002)+RS1
    1 CONTINUE  ! END (all,i,EGY_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00285"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00026,C00076,C00121,C00123,C00274,C00286,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00274(SSZ(15),SSZ(1))
      REAL C00286(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00286"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1361
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00286"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*C00121(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)-C00076(SSMP(SSMPST(15)-1+I00001))*
     *  C00123(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00121(SSMP(SSMPST(15)-1+I00001),I00004,I00002))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00286(I00001,I00002)=C00274(I00001,I00002)+RS1
    1 CONTINUE  ! END (all,i,EGY_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00286"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00026,C00076,C00120,C00122,C00123,C00275,C00287,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00275(SSZ(15),SSZ(1))
      REAL C00287(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00287"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1363
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00287"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*100.0 *
     *  C00122(SSMP(SSMPST(15)-1+I00001),I00004,I00002)+
     *  C00076(SSMP(SSMPST(15)-1+I00001))*(-C00123(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)*100.0 *C00122(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)-(1  -C00123(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002))*100.0 *C00120(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00287(I00001,I00002)=RS1+C00275(I00001,I00002)
    1 CONTINUE  ! END (all,i,EGY_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00287"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00013,C00019,C00026,C00076,C00086,C00090,C00100,C00104,
     *  C00119,C00123,C00288,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00288(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00288"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1365
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00288"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*(1  -C00123(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002))*C00119(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00288(I00001,I00002)=-C00013(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*(1  -C00090(SSMP(SSMPST(15)-1+
     *  I00001),I00002))*C00086(SSMP(SSMPST(15)-1+I00001),I00002)-
     *  C00019(SSMP(SSMPST(15)-1+I00001),I00002)*C00076(SSMP(SSMPST(15)-
     *  1+I00001))*(1  -C00104(SSMP(SSMPST(15)-1+I00001),I00002))*
     *  C00100(SSMP(SSMPST(15)-1+I00001),I00002)+RS1
    1 CONTINUE  ! END (all,i,EGY_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00288"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00013,C00019,C00026,C00076,C00088,C00090,C00102,C00104,
     *  C00121,C00123,C00289,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00289(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00289"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1367
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00289"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RS1=C00019(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*C00102(SSMP(SSMPST(15)-1+
     *  I00001),I00002)-C00019(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*C00104(SSMP(SSMPST(15)-1+
     *  I00001),I00002)*C00102(SSMP(SSMPST(15)-1+I00001),I00002)
      RS2=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=RS2+C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*C00121(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)-C00076(SSMP(SSMPST(15)-1+I00001))*
     *  C00123(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00121(SSMP(SSMPST(15)-1+I00001),I00004,I00002))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00289(I00001,I00002)=C00013(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*C00088(SSMP(SSMPST(15)-1+
     *  I00001),I00002)-C00076(SSMP(SSMPST(15)-1+I00001))*
     *  C00090(SSMP(SSMPST(15)-1+I00001),I00002)*C00088(SSMP(SSMPST(15)-
     *  1+I00001),I00002))+RS1+RS2
    1 CONTINUE  ! END (all,i,EGY_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00289"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00013,C00019,C00026,C00076,C00087,C00089,C00090,C00101,
     *  C00103,C00104,C00120,C00122,C00123,C00290,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00290(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00290"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1369
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00290"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*100.0 *
     *  C00122(SSMP(SSMPST(15)-1+I00001),I00004,I00002)+
     *  C00076(SSMP(SSMPST(15)-1+I00001))*(-C00123(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)*100.0 *C00122(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)-(1  -C00123(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002))*100.0 *C00120(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      RS2=C00013(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*100.0 *
     *  C00089(SSMP(SSMPST(15)-1+I00001),I00002)+C00076(SSMP(SSMPST(15)-
     *  1+I00001))*(-C00090(SSMP(SSMPST(15)-1+I00001),I00002)*100.0 *
     *  C00089(SSMP(SSMPST(15)-1+I00001),I00002)-(1  -
     *  C00090(SSMP(SSMPST(15)-1+I00001),I00002))*100.0 *
     *  C00087(SSMP(SSMPST(15)-1+I00001),I00002)))
      C00290(I00001,I00002)=RS1+C00019(SSMP(SSMPST(15)-1+
     *  I00001),I00002)*C00076(SSMP(SSMPST(15)-1+I00001))*100.0 *
     *  C00103(SSMP(SSMPST(15)-1+I00001),I00002)+RS2+
     *  C00019(SSMP(SSMPST(15)-1+I00001),I00002)*C00076(SSMP(SSMPST(15)-
     *  1+I00001))*(-C00104(SSMP(SSMPST(15)-1+I00001),I00002)*100.0 *
     *  C00103(SSMP(SSMPST(15)-1+I00001),I00002)-(1  -
     *  C00104(SSMP(SSMPST(15)-1+I00001),I00002))*100.0 *
     *  C00101(SSMP(SSMPST(15)-1+I00001),I00002))
    1 CONTINUE  ! END (all,i,EGY_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00290"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00056,C00060,C00061,C00065,C00066,C00076,C00086,
     *  C00090,C00100,C00104,C00119,C00123,C00243,C00291,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00291(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00291"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1371
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00291"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*C00076(I00001)*(1  -
     *  C00123(I00001,I00004,I00002))*C00119(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00291(I00001,I00002)=-0.01  *C00243(I00002)*
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))*C00076(I00001)*
     *  (1  -C00090(I00001,I00002))*C00086(I00001,I00002)-0.01  *
     *  C00243(I00002)*(C00060(I00001,I00002)+C00061(I00001,I00002))*
     *  C00076(I00001)*(1  -C00104(I00001,I00002))*
     *  C00100(I00001,I00002)+RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00291"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00056,C00060,C00061,C00065,C00066,C00076,C00088,
     *  C00090,C00102,C00104,C00121,C00123,C00243,C00292,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00292(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00292"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1373
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00292"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*(C00076(I00001)*
     *  C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00292(I00001,I00002)=0.01  *C00243(I00002)*
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))*(C00076(I00001)*
     *  C00088(I00001,I00002)-C00076(I00001)*C00090(I00001,I00002)*
     *  C00088(I00001,I00002))+0.01  *C00243(I00002)*
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*C00076(I00001)*
     *  C00102(I00001,I00002)-0.01  *C00243(I00002)*
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*C00076(I00001)*
     *  C00104(I00001,I00002)*C00102(I00001,I00002)+RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00292"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00056,C00076,C00120,C00122,C00123,C00243,C00270,
     *  C00293,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00270(SSZ(1))
      REAL C00293(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00293"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1375
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00293"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*(C00076(I00001)*100.0 *
     *  C00122(I00001,I00004,I00002)+C00076(I00001)*(-
     *  C00123(I00001,I00004,I00002)*100.0 *
     *  C00122(I00001,I00004,I00002)-(1  -C00123(I00001,I00004,I00002))*
     *  100.0 *C00120(I00001,I00004,I00002)))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00293(I00002)=RS1+C00270(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00293"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00056,C00076,C00119,C00123,C00243,C00294,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00294(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00294"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1377
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00294"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  C00076(I00001)*(1  -C00123(I00001,I00004,I00002))*
     *  C00119(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00294(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00294"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00056,C00076,C00121,C00123,C00243,C00295,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00295(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00295"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1379
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00295"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  (C00076(I00001)*C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00295(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00295"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00056,C00076,C00120,C00122,C00123,C00243,C00296,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00296(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00296"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1381
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00296"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  (C00076(I00001)*100.0 *C00122(I00001,I00004,I00002)+
     *  C00076(I00001)*(-C00123(I00001,I00004,I00002)*100.0 *
     *  C00122(I00001,I00004,I00002)-(1  -C00123(I00001,I00004,I00002))*
     *  100.0 *C00120(I00001,I00004,I00002)))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00296(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00296"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00056,C00243,C00297,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00297(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00297"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1383
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00297"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00297(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00297"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00056,C00076,C00120,C00122,C00123,C00243,C00298,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00298(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00298"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1385
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00298"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  (C00076(I00001)*100.0 *C00122(I00001,I00004,I00002)+
     *  C00076(I00001)*(-C00123(I00001,I00004,I00002)*100.0 *
     *  C00122(I00001,I00004,I00002)-(1  -C00123(I00001,I00004,I00002))*
     *  100.0 *C00120(I00001,I00004,I00002)))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00298(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00298"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00056,C00243,C00299,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00299(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00299"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1387
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00299"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00299(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00299"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00055,C00056,C00060,C00061,C00065,C00066,C00076,C00087,
     *  C00089,C00090,C00101,C00103,C00104,C00120,C00122,C00123,
     *  C00243,C00300,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00300(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00300"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1389
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00300"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*(C00076(I00001)*100.0 *
     *  C00122(I00001,I00004,I00002)+C00076(I00001)*(-
     *  C00123(I00001,I00004,I00002)*100.0 *
     *  C00122(I00001,I00004,I00002)-(1  -C00123(I00001,I00004,I00002))*
     *  100.0 *C00120(I00001,I00004,I00002)))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      RS2=RS1+0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*100.0 *
     *  C00103(I00001,I00002)+0.01  *C00243(I00002)*
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))*(C00076(I00001)*
     *  100.0 *C00089(I00001,I00002)+C00076(I00001)*(-
     *  C00090(I00001,I00002)*100.0 *C00089(I00001,I00002)-(1  -
     *  C00090(I00001,I00002))*100.0 *C00087(I00001,I00002)))
      C00300(I00001,I00002)=RS2+0.01  *C00243(I00002)*
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*C00076(I00001)*(-
     *  C00104(I00001,I00002)*100.0 *C00103(I00001,I00002)-(1  -
     *  C00104(I00001,I00002))*100.0 *C00101(I00001,I00002))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00300"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00045,C00243,C00301,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00301(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00301"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1391
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00301"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(7)  ! SUM(i,PROD_COMM
      RS1=RS1-0.01  *C00243(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
    2 CONTINUE  ! END SUM(i,PROD_COMM
      C00301(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00301"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00045,C00243,C00302,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00302(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00302"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1393
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00302"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(7)  ! SUM(i,PROD_COMM
      RS1=RS1+C00045(SSMP(SSMPST(9)-1+I00001),I00002)
    2 CONTINUE  ! END SUM(i,PROD_COMM
      C00302(I00002)=-0.01  *C00243(I00002)*RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00302"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00125,C00303,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00125(SSZ(36),SSZ(7),SSZ(1))
      REAL C00303(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00303"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1395
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00303"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(36)  ! SUM(k,NCOAL_FCOMM
      RS1=RS1-C00125(I00008,I00004,I00002)
    3 CONTINUE  ! END SUM(k,NCOAL_FCOMM
      C00303(I00004,I00002)=-RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00303"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00292')
      RETURN
      END
      SUBROUTINE S00293(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00128,C00304,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00128(SSZ(38),SSZ(7),SSZ(1))
      REAL C00304(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00304"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1397
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00304"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(38)  ! SUM(k,NELY_FCOMM
      RS1=RS1-C00128(I00008,I00004,I00002)
    3 CONTINUE  ! END SUM(k,NELY_FCOMM
      C00304(I00004,I00002)=-RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00304"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00131,C00305,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00131(SSZ(40),SSZ(7),SSZ(1))
      REAL C00305(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00305"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1399
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00305"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(40)  ! SUM(k,ENY_FCOMM
      RS1=RS1-C00131(I00008,I00004,I00002)
    3 CONTINUE  ! END SUM(k,ENY_FCOMM
      C00305(I00004,I00002)=-RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00305"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00294')
      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(1301).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00256',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1301).NE.'n') then
      CALL S00245(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1301),
     *  C00048,C00087,C00089,C00090,C00256,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1303).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00257',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1303).NE.'n') then
      CALL S00246(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1303),
     *  C00065,C00076,C00087,C00089,C00090,C00257,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1305).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00258',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1305).NE.'n') then
      CALL S00247(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1305),
     *  C00065,C00066,C00076,C00087,C00089,C00090,C00243,C00258,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1307).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00259',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1307).NE.'n') then
      CALL S00248(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1307),
     *  C00031,C00045,C00053,C00054,C00055,C00056,C00058,C00059,
     *  C00060,C00061,C00063,C00064,C00065,C00066,C00068,C00070,
     *  C00072,C00074,C00226,C00243,C00259,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1309).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00260',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1309).NE.'n') then
      CALL S00249(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1309),
     *  C00065,C00066,C00076,C00087,C00089,C00090,C00243,C00260,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1311).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00261',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1311).NE.'n') then
      CALL S00250(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1311),
     *  C00065,C00066,C00243,C00261,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1313).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00262',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1313).NE.'n') then
      CALL S00251(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1313),
     *  C00053,C00054,C00055,C00056,C00058,C00059,C00060,C00061,
     *  C00063,C00064,C00065,C00066,C00068,C00070,C00072,C00074,
     *  C00243,C00262,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1315).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00263',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1315).NE.'n') then
      CALL S00252(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1315),
     *  C00053,C00054,C00055,C00056,C00058,C00059,C00060,C00061,
     *  C00063,C00064,C00065,C00066,C00070,C00072,C00074,C00243,
     *  C00263,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1317).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00264',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1317).NE.'n') then
      CALL S00253(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1317),
     *  C00060,C00076,C00103,C00264,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1319).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00265',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1319).NE.'n') then
      CALL S00254(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1319),
     *  C00060,C00061,C00076,C00103,C00243,C00258,C00265,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1321).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00266',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1321).NE.'n') then
      CALL S00255(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1321),
     *  C00060,C00061,C00076,C00103,C00243,C00266,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1323).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00267',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1323).NE.'n') then
      CALL S00256(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1323),
     *  C00060,C00061,C00243,C00267,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1325).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00268',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1325).NE.'n') then
      CALL S00257(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1325),
     *  C00060,C00076,C00101,C00103,C00104,C00264,C00268,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1327).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00269',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1327).NE.'n') then
      CALL S00258(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1327),
     *  C00050,C00101,C00103,C00104,C00256,C00269,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1329).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00270',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1329).NE.'n') then
      CALL S00259(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1329),
     *  C00060,C00061,C00076,C00101,C00103,C00104,C00243,C00265,
     *  C00270,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1331).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00271',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1331).NE.'n') then
      CALL S00260(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1331),
     *  C00060,C00061,C00076,C00101,C00103,C00104,C00243,C00266,
     *  C00271,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1333).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00272',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1333).NE.'n') then
      CALL S00261(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1333),
     *  C00010,C00013,C00016,C00019,C00024,C00076,C00086,C00090,
     *  C00100,C00104,C00119,C00272,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1335).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00273',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1335).NE.'n') then
      CALL S00262(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1335),
     *  C00010,C00013,C00016,C00019,C00024,C00076,C00087,C00089,
     *  C00090,C00101,C00103,C00104,C00120,C00273,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1337).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00274',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1337).NE.'n') then
      CALL S00263(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1337),
     *  C00013,C00019,C00026,C00076,C00088,C00090,C00102,C00104,
     *  C00121,C00274,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1339).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00275',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1339).NE.'n') then
      CALL S00264(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1339),
     *  C00026,C00122,C00273,C00275,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1341).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00276',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1341).NE.'n') then
      CALL S00265(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1341),
     *  C00044,C00048,C00050,C00086,C00090,C00100,C00104,C00119,
     *  C00123,C00276,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1343).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00277',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1343).NE.'n') then
      CALL S00266(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1343),
     *  C00044,C00048,C00050,C00088,C00090,C00102,C00104,C00121,
     *  C00123,C00277,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1345).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00278',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1345).NE.'n') then
      CALL S00267(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1345),
     *  C00044,C00048,C00050,C00087,C00089,C00090,C00101,C00103,
     *  C00104,C00120,C00122,C00123,C00278,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1347).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00279',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1347).NE.'n') then
      CALL S00268(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1347),
     *  C00053,C00055,C00076,C00119,C00123,C00279,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1349).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00280',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1349).NE.'n') then
      CALL S00269(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1349),
     *  C00055,C00076,C00121,C00123,C00280,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1351).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00281',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1351).NE.'n') then
      CALL S00270(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1351),
     *  C00055,C00076,C00120,C00122,C00123,C00281,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1353).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00282',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1353).NE.'n') then
      CALL S00271(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1353),
     *  C00076,C00086,C00090,C00100,C00104,C00119,C00123,C00205,
     *  C00206,C00207,C00282,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1355).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00283',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1355).NE.'n') then
      CALL S00272(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1355),
     *  C00076,C00088,C00090,C00102,C00104,C00121,C00123,C00205,
     *  C00206,C00207,C00283,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1357).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00284',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1357).NE.'n') then
      CALL S00273(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1357),
     *  C00076,C00087,C00089,C00090,C00101,C00103,C00104,C00120,
     *  C00122,C00123,C00205,C00206,C00207,C00284,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1359).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00285',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1359).NE.'n') then
      CALL S00274(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1359),
     *  C00026,C00076,C00119,C00123,C00272,C00285,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1361).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00286',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1361).NE.'n') then
      CALL S00275(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1361),
     *  C00026,C00076,C00121,C00123,C00274,C00286,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1363).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00287',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1363).NE.'n') then
      CALL S00276(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1363),
     *  C00026,C00076,C00120,C00122,C00123,C00275,C00287,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1365).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00288',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1365).NE.'n') then
      CALL S00277(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1365),
     *  C00013,C00019,C00026,C00076,C00086,C00090,C00100,C00104,
     *  C00119,C00123,C00288,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1367).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00289',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1367).NE.'n') then
      CALL S00278(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1367),
     *  C00013,C00019,C00026,C00076,C00088,C00090,C00102,C00104,
     *  C00121,C00123,C00289,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1369).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00290',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1369).NE.'n') then
      CALL S00279(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1369),
     *  C00013,C00019,C00026,C00076,C00087,C00089,C00090,C00101,
     *  C00103,C00104,C00120,C00122,C00123,C00290,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1371).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00291',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1371).NE.'n') then
      CALL S00280(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1371),
     *  C00055,C00056,C00060,C00061,C00065,C00066,C00076,C00086,
     *  C00090,C00100,C00104,C00119,C00123,C00243,C00291,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1373).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00292',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1373).NE.'n') then
      CALL S00281(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1373),
     *  C00055,C00056,C00060,C00061,C00065,C00066,C00076,C00088,
     *  C00090,C00102,C00104,C00121,C00123,C00243,C00292,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1375).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00293',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1375).NE.'n') then
      CALL S00282(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1375),
     *  C00055,C00056,C00076,C00120,C00122,C00123,C00243,C00270,
     *  C00293,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1377).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00294',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1377).NE.'n') then
      CALL S00283(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1377),
     *  C00055,C00056,C00076,C00119,C00123,C00243,C00294,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1379).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00295',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1379).NE.'n') then
      CALL S00284(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1379),
     *  C00055,C00056,C00076,C00121,C00123,C00243,C00295,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1381).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00296',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1381).NE.'n') then
      CALL S00285(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1381),
     *  C00055,C00056,C00076,C00120,C00122,C00123,C00243,C00296,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1383).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00297',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1383).NE.'n') then
      CALL S00286(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1383),
     *  C00055,C00056,C00243,C00297,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1385).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00298',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1385).NE.'n') then
      CALL S00287(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1385),
     *  C00055,C00056,C00076,C00120,C00122,C00123,C00243,C00298,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1387).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00299',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1387).NE.'n') then
      CALL S00288(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1387),
     *  C00055,C00056,C00243,C00299,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1389).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00300',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1389).NE.'n') then
      CALL S00289(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1389),
     *  C00055,C00056,C00060,C00061,C00065,C00066,C00076,C00087,
     *  C00089,C00090,C00101,C00103,C00104,C00120,C00122,C00123,
     *  C00243,C00300,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1391).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00301',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1391).NE.'n') then
      CALL S00290(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1391),
     *  C00045,C00243,C00301,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1393).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00302',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1393).NE.'n') then
      CALL S00291(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1393),
     *  C00045,C00243,C00302,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1395).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00303',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1395).NE.'n') then
      CALL S00292(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1395),
     *  C00125,C00303,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1397).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00304',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1397).NE.'n') then
      CALL S00293(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1397),
     *  C00128,C00304,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1399).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00305',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1399).NE.'n') then
      CALL S00294(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1399),
     *  C00131,C00305,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00010')
      RETURN
      END
      SUBROUTINE S00295(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00134,C00306,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00134(SSZ(41),SSZ(7),SSZ(1))
      REAL C00306(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00306"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1401
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00306"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(41)  ! SUM(k,KEN_FCOMM
      RS1=RS1-C00134(I00008,I00004,I00002)
    3 CONTINUE  ! END SUM(k,KEN_FCOMM
      C00306(I00004,I00002)=-RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00306"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00137,C00307,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00137(SSZ(44),SSZ(7),SSZ(1))
      REAL C00307(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00307"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1403
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00307"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(44)  ! SUM(k,VAEN_FCOMM
      RS1=RS1-C00137(I00008,I00004,I00002)
    3 CONTINUE  ! END SUM(k,VAEN_FCOMM
      C00307(I00004,I00002)=-RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00307"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00140,C00308,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00140(SSZ(46),SSZ(7),SSZ(1))
      REAL C00308(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00308"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1405
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00308"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(46)  ! SUM(k,EBL_COMM
      RS1=RS1-C00140(I00008,I00004,I00002)
    3 CONTINUE  ! END SUM(k,EBL_COMM
      C00308(I00004,I00002)=-RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00308"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00143,C00309,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00143(SSZ(48),SSZ(7),SSZ(1))
      REAL C00309(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00309"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1407
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00309"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(48)  ! SUM(k,EPP_COMM
      RS1=RS1-C00143(I00008,I00004,I00002)
    3 CONTINUE  ! END SUM(k,EPP_COMM
      C00309(I00004,I00002)=-RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00309"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00146,C00310,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00146(SSZ(50),SSZ(7),SSZ(1))
      REAL C00310(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00310"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1409
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00310"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(50)  ! SUM(k,EGEN_COMM
      RS1=RS1-C00146(I00008,I00004,I00002)
    3 CONTINUE  ! END SUM(k,EGEN_COMM
      C00310(I00004,I00002)=-RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00310"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00149,C00311,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00149(SSZ(52),SSZ(7),SSZ(1))
      REAL C00311(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00311"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1411
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00311"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(52)  ! SUM(k,ELYO_COMM
      RS1=RS1-C00149(I00008,I00004,I00002)
    3 CONTINUE  ! END SUM(k,ELYO_COMM
      C00311(I00004,I00002)=-RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00311"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00154,C00312,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00154(SSZ(56),SSZ(7),SSZ(1))
      REAL C00312(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00312"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1413
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00312"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(56)  ! SUM(i,OUT_COMM
      RS1=RS1+C00154(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(i,OUT_COMM
      C00312(I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00312"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00243,C00313,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00313(SSZ(35),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00313"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1415
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00313"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(35)  ! (all,i,FIRM_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-0.01  *C00243(I00002)*C00116(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00313(I00001,I00002)=RS1
    1 CONTINUE  ! END (all,i,FIRM_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00313"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00243,C00314,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00314(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00314"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1417
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00314"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(35)  ! SUM(i,FIRM_COMM
      RS1=RS1-0.01  *C00243(I00002)*C00116(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(i,FIRM_COMM
      C00314(I00004,I00002)=RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00314"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00243,C00315,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00315(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00315"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1419
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00315"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=0.0
      DO 2 I00001=1,SSZ(35)  ! SUM(i,FIRM_COMM
      RS2=RS2-0.01  *C00243(I00002)*C00116(I00001,I00004,I00002)
    2 CONTINUE  ! END SUM(i,FIRM_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00315(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00315"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00243,C00316,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00316(SSZ(35),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00316"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1421
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00316"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(35)  ! (all,i,FIRM_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00116(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00316(I00001,I00002)=-0.01  *C00243(I00002)*RS1
    1 CONTINUE  ! END (all,i,FIRM_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00316"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00243,C00317,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00317(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00317"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1423
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00317"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RS1=0.0
      DO 3 I00001=1,SSZ(35)  ! SUM(i,FIRM_COMM
      RS1=RS1+C00116(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(i,FIRM_COMM
      C00317(I00004,I00002)=-0.01  *C00243(I00002)*RS1
    1 CONTINUE  ! END (all,j,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00317"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00116,C00243,C00318,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00318(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00318"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1425
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00318"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=0.0
      DO 3 I00001=1,SSZ(35)  ! SUM(i,FIRM_COMM
      RS2=RS2+C00116(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(i,FIRM_COMM
      RS1=RS1+RS2
    2 CONTINUE  ! END SUM(j,PROD_COMM
      C00318(I00002)=-0.01  *C00243(I00002)*RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00318"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00068,C00319,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00319(SSZ(11),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00319"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1427
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00319"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(11)  ! (all,i,ENDWM_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+C00068(SSMP(SSMPST(11)-1+I00001),I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00319(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,ENDWM_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00319"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00068,C00243,C00320,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00320(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00320"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1429
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00320"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=0.0
      DO 2 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      RS2=RS2-C00068(I00001,I00004,I00002)*0.01  *C00243(I00002)
    2 CONTINUE  ! END SUM(i,ENDW_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00320(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00320"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00068,C00243,C00321,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00321(SSZ(6),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00321"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1431
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00321"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-C00068(I00001,I00004,I00002)*0.01  *C00243(I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00321(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,ENDW_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00321"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00068,C00070,C00243,C00322,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00322(SSZ(6),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00322"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1433
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00322"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-C00068(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      C00322(I00001,I00002)=-0.01  *C00243(I00002)*(-
     *  C00070(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)+RS1)
    1 CONTINUE  ! END (all,i,ENDW_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00322"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00072,C00323,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00323(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00323"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1435
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00323"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00072(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00323(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00323"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00035,C00072,C00324,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00324(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00324"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1437
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00324"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1-C00035(I00001,I00002,I00003)-C00072(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00324(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00324"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00325,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00325(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00325"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1439
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00325"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00325(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00325"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00326,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00326(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00326"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1441
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00326"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1-C00034(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00326(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00326"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00048,C00050,C00086,C00090,C00100,C00104,C00327,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00327(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00327"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1443
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00327"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1-C00034(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00327(I00001,I00002)=-C00048(I00001,I00002)*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)-
     *  C00050(I00001,I00002)*(1  -C00104(I00001,I00002))*
     *  C00100(I00001,I00002)+RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00327"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00328,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00328(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00328"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1445
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00328"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00328(I00001,I00002)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00328"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00036,C00329,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00329(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00329"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1447
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00329"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00329(I00005,I00002)=-(RS1+C00036(I00005,I00002))
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00329"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00330,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00330(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00330"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1449
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00330"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1-C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00330(I00005,I00002)=-RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00330"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00331,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00331(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00331"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1451
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00331"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00331(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,NMRG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00331"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00332,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00332(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00332"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1453
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00332"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1-C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00332(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,NMRG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00332"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00243,C00291,C00333,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00291(SSZ(2),SSZ(1))
      REAL C00333(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00333"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1455
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00333"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1-0.01  *C00243(I00002)*C00034(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00333(I00001,I00002)=C00291(I00001,I00002)+RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00333"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00243,C00334,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00334(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00334"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1457
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00334"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+0.01  *C00243(I00002)*C00034(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00334(I00001,I00002)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00334"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00243,C00335,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00335(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00335"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1459
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00335"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00034(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00335(I00001,I00002)=-0.01  *C00243(I00002)*RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00335"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00243,C00336,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00336(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00336"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1461
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00336"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1-C00034(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00336(I00001,I00002)=-0.01  *C00243(I00002)*RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00336"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00034,C00036,C00243,C00244,C00337,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3,RS4,RS5,RS6
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00244(SSZ(3),SSZ(1))
      REAL C00337(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00337"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1463
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00337"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-C00034(I00001,I00002,I00003)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(s,REG
      RS3=0.0
      DO 4 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS3=RS3-C00036(I00005,I00002)
    4 CONTINUE  ! END SUM(m,MARG_COMM
      RS4=0.0
      DO 6 I00003=1,SSZ(1)  ! SUM(s,REG
      RS5=0.0
      DO 5 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS5=RS5-C00034(I00001,I00003,I00002)
    5 CONTINUE  ! END SUM(i,TRAD_COMM
      RS4=RS4+RS5
    6 CONTINUE  ! END SUM(s,REG
      RS6=0.0
      DO 7 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS6=RS6-C00244(I00005,I00002)
    7 CONTINUE  ! END SUM(m,MARG_COMM
      C00337(I00002)=-0.01  *C00243(I00002)*(RS1+RS3-RS4-RS6)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00337"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00250,C00251,C00338,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00250(SSZ(2),SSZ(1),SSZ(1))
      REAL C00251(SSZ(3),SSZ(1))
      REAL C00338(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00338"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1465
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00338"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00250(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00338(I00005,I00002)=-(RS1+C00251(I00005,I00002))
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00338"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00250,C00339,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00250(SSZ(2),SSZ(1),SSZ(1))
      REAL C00339(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00339"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1467
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00339"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1-C00250(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00339(I00005,I00002)=-RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00339"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00250,C00340,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00250(SSZ(2),SSZ(1),SSZ(1))
      REAL C00340(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00340"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1469
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00340"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00250(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00340(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,NMRG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00340"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00250,C00341,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00250(SSZ(2),SSZ(1),SSZ(1))
      REAL C00341(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00341"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1471
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00341"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1-C00250(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
    3 CONTINUE  ! END SUM(s,REG
      C00341(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,NMRG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00341"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00160,C00342,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00160(SSZ(2),SSZ(1),SSZ(1))
      REAL C00342(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00342"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1473
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00342"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)  ! SUM(k,REG
      RS1=RS1+C00160(I00001,I00008,I00003)
    3 CONTINUE  ! END SUM(k,REG
      C00342(I00001,I00003)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00342"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00168,C00343,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00168(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00343(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00343"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1475
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00343"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00002=1,SSZ(1)  ! SUM(r,REG
      RS3=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS3=RS3+C00168(I00005,I00001,I00002,I00003)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS2=RS2+RS3
    3 CONTINUE  ! END SUM(r,REG
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00343(I00005)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00343"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  DOCIG,
     *  C00168,C00344,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00168(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00344(SSZ(3),SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00344"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1477
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00344"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00002=1,SSZ(1)  ! SUM(r,REG
      RS2=RS2+C00168(I00005,I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(r,REG
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00344(I00005,I00001)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00344"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00333')
      RETURN
      END
      SUBROUTINE S00334(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00168,C00345,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00168(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00345(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00345"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1479
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00345"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00168(I00005,I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00345(I00005,I00002)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00345"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00334')
      RETURN
      END
      SUBROUTINE S00335(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00168,C00346,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00168(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00346(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00346"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1481
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00346"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)  ! SUM(r,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00168(I00005,I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(r,REG
      C00346(I00005,I00003)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00346"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00335')
      RETURN
      END
      SUBROUTINE S00336(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00171,C00174,C00347,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00347"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1483
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00347"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 4 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS1=RS1+C00174(I00001,I00002,I00003)*
     *  C00171(I00005,I00001,I00002,I00003)
    4 CONTINUE  ! END SUM(m,MARG_COMM
      C00347(I00001,I00002,I00003)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00347"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00336')
      RETURN
      END
      SUBROUTINE S00337(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00162,C00243,C00348,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00348(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00348"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1485
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00348"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-0.01  *C00243(I00002)*C00162(I00005,I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00348(I00005,I00002)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00348"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00337')
      RETURN
      END
      SUBROUTINE S00338(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00162,C00243,C00349,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00349(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00349"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1487
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00349"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS2=RS2-0.01  *C00243(I00002)*C00162(I00005,I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(m,MARG_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00349(I00001,I00002)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00349"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00338')
      RETURN
      END
      SUBROUTINE S00339(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00162,C00243,C00350,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00350(SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00350"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1489
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00350"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      RS1=0.0
      DO 4 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=0.0
      DO 3 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS2=RS2-0.01  *C00243(I00002)*C00162(I00005,I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(m,MARG_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(i,TRAD_COMM
      C00350(I00003,I00002)=RS1
    1 CONTINUE  ! END (all,s,REG)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00350"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00339')
      RETURN
      END
      SUBROUTINE S00340(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00162,C00243,C00351,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00351(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00351"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1491
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00351"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS3=0.0
      DO 2 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS3=RS3-0.01  *C00243(I00002)*C00162(I00005,I00001,I00003,I00002)
    2 CONTINUE  ! END SUM(m,MARG_COMM
      RS2=RS2+RS3
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00351(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00351"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00340')
      RETURN
      END
      SUBROUTINE S00341(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00162,C00243,C00352,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00352(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00352"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1493
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00352"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00162(I00005,I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00352(I00005,I00002)=-0.01  *C00243(I00002)*RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00352"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00341')
      RETURN
      END
      SUBROUTINE S00342(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00162,C00243,C00353,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00353(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00353"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1495
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00353"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS2=RS2+C00162(I00005,I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(m,MARG_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00353(I00001,I00002)=-0.01  *C00243(I00002)*RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00353"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00342')
      RETURN
      END
      SUBROUTINE S00343(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00162,C00243,C00354,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00354(SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00354"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1497
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00354"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      RS1=0.0
      DO 4 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=0.0
      DO 3 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS2=RS2+C00162(I00005,I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(m,MARG_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(i,TRAD_COMM
      C00354(I00003,I00002)=-0.01  *C00243(I00002)*RS1
    1 CONTINUE  ! END (all,s,REG)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00354"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00343')
      RETURN
      END
      SUBROUTINE S00344(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00162,C00243,C00355,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00355(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00355"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1499
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00355"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS3=0.0
      DO 2 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS3=RS3+C00162(I00005,I00001,I00003,I00002)
    2 CONTINUE  ! END SUM(m,MARG_COMM
      RS2=RS2+RS3
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00355(I00002)=-0.01  *C00243(I00002)*RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00355"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00344')
      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(1401).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00306',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1401).NE.'n') then
      CALL S00295(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1401),
     *  C00134,C00306,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1403).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00307',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1403).NE.'n') then
      CALL S00296(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1403),
     *  C00137,C00307,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1405).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00308',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1405).NE.'n') then
      CALL S00297(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1405),
     *  C00140,C00308,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1407).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00309',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1407).NE.'n') then
      CALL S00298(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1407),
     *  C00143,C00309,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1409).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00310',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1409).NE.'n') then
      CALL S00299(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1409),
     *  C00146,C00310,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1411).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00311',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1411).NE.'n') then
      CALL S00300(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1411),
     *  C00149,C00311,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1413).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00312',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1413).NE.'n') then
      CALL S00301(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1413),
     *  C00154,C00312,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1415).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00313',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1415).NE.'n') then
      CALL S00302(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1415),
     *  C00116,C00243,C00313,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1417).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00314',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1417).NE.'n') then
      CALL S00303(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1417),
     *  C00116,C00243,C00314,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1419).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00315',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1419).NE.'n') then
      CALL S00304(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1419),
     *  C00116,C00243,C00315,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1421).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00316',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1421).NE.'n') then
      CALL S00305(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1421),
     *  C00116,C00243,C00316,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1423).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00317',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1423).NE.'n') then
      CALL S00306(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1423),
     *  C00116,C00243,C00317,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1425).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00318',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1425).NE.'n') then
      CALL S00307(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1425),
     *  C00116,C00243,C00318,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1427).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00319',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1427).NE.'n') then
      CALL S00308(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1427),
     *  C00068,C00319,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1429).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00320',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1429).NE.'n') then
      CALL S00309(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1429),
     *  C00068,C00243,C00320,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1431).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00321',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1431).NE.'n') then
      CALL S00310(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1431),
     *  C00068,C00243,C00321,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1433).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00322',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1433).NE.'n') then
      CALL S00311(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1433),
     *  C00068,C00070,C00243,C00322,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1435).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00323',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1435).NE.'n') then
      CALL S00312(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1435),
     *  C00072,C00323,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1437).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00324',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1437).NE.'n') then
      CALL S00313(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1437),
     *  C00035,C00072,C00324,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1439).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00325',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1439).NE.'n') then
      CALL S00314(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1439),
     *  C00034,C00325,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1441).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00326',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1441).NE.'n') then
      CALL S00315(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1441),
     *  C00034,C00326,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1443).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00327',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1443).NE.'n') then
      CALL S00316(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1443),
     *  C00034,C00048,C00050,C00086,C00090,C00100,C00104,C00327,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1445).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00328',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1445).NE.'n') then
      CALL S00317(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1445),
     *  C00034,C00328,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1447).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00329',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1447).NE.'n') then
      CALL S00318(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1447),
     *  C00034,C00036,C00329,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1449).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00330',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1449).NE.'n') then
      CALL S00319(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1449),
     *  C00034,C00330,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1451).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00331',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1451).NE.'n') then
      CALL S00320(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1451),
     *  C00034,C00331,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1453).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00332',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1453).NE.'n') then
      CALL S00321(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1453),
     *  C00034,C00332,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1455).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00333',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1455).NE.'n') then
      CALL S00322(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1455),
     *  C00034,C00243,C00291,C00333,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1457).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00334',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1457).NE.'n') then
      CALL S00323(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1457),
     *  C00034,C00243,C00334,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1459).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00335',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1459).NE.'n') then
      CALL S00324(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1459),
     *  C00034,C00243,C00335,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1461).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00336',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1461).NE.'n') then
      CALL S00325(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1461),
     *  C00034,C00243,C00336,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1463).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00337',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1463).NE.'n') then
      CALL S00326(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1463),
     *  C00034,C00036,C00243,C00244,C00337,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1465).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00338',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1465).NE.'n') then
      CALL S00327(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1465),
     *  C00250,C00251,C00338,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1467).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00339',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1467).NE.'n') then
      CALL S00328(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1467),
     *  C00250,C00339,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1469).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00340',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1469).NE.'n') then
      CALL S00329(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1469),
     *  C00250,C00340,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1471).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00341',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1471).NE.'n') then
      CALL S00330(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1471),
     *  C00250,C00341,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1473).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00342',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1473).NE.'n') then
      CALL S00331(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1473),
     *  C00160,C00342,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1475).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00343',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1475).NE.'n') then
      CALL S00332(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1475),
     *  C00168,C00343,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1477).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00344',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1477).NE.'n') then
      CALL S00333(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1477),
     *  C00168,C00344,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1479).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00345',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1479).NE.'n') then
      CALL S00334(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1479),
     *  C00168,C00345,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1481).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00346',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1481).NE.'n') then
      CALL S00335(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1481),
     *  C00168,C00346,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1483).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00347',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1483).NE.'n') then
      CALL S00336(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1483),
     *  C00171,C00174,C00347,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1485).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00348',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1485).NE.'n') then
      CALL S00337(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1485),
     *  C00162,C00243,C00348,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1487).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00349',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1487).NE.'n') then
      CALL S00338(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1487),
     *  C00162,C00243,C00349,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1489).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00350',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1489).NE.'n') then
      CALL S00339(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1489),
     *  C00162,C00243,C00350,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1491).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00351',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1491).NE.'n') then
      CALL S00340(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1491),
     *  C00162,C00243,C00351,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1493).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00352',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1493).NE.'n') then
      CALL S00341(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1493),
     *  C00162,C00243,C00352,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1495).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00353',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1495).NE.'n') then
      CALL S00342(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1495),
     *  C00162,C00243,C00353,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1497).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00354',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1497).NE.'n') then
      CALL S00343(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1497),
     *  C00162,C00243,C00354,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1499).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00355',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1499).NE.'n') then
      CALL S00344(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1499),
     *  C00162,C00243,C00355,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00011')
      RETURN
      END
      SUBROUTINE S00345(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00160,C00171,C00174,C00356,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00160(SSZ(2),SSZ(1),SSZ(1))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00356(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00356"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1501
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00356"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00008=1,SSZ(1)  ! SUM(k,REG
      RS1=RS1+C00160(I00001,I00008,I00003)*C00174(I00001,I00008,I00003)*
     *  C00171(I00005,I00001,I00008,I00003)
    4 CONTINUE  ! END SUM(k,REG
      C00356(I00005,I00001,I00003)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00356"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00345')
      RETURN
      END
      SUBROUTINE S00346(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00160,C00347,C00357,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00160(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL C00357(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00357"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1503
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00357"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)  ! SUM(k,REG
      RS1=RS1+C00160(I00001,I00008,I00003)*C00347(I00001,I00008,I00003)
    3 CONTINUE  ! END SUM(k,REG
      C00357(I00001,I00003)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00357"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00346')
      RETURN
      END
      SUBROUTINE S00347(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00160,C00171,C00174,C00358,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00003
      INTEGER I00005
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00160(SSZ(2),SSZ(1),SSZ(1))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00358(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00358"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1505
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00358"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00008=1,SSZ(1)  ! SUM(k,REG
      RS1=RS1-C00160(I00001,I00008,I00003)*C00174(I00001,I00008,I00003)*
     *  C00171(I00005,I00001,I00008,I00003)
    4 CONTINUE  ! END SUM(k,REG
      C00358(I00005,I00001,I00003)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00358"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00347')
      RETURN
      END
      SUBROUTINE S00348(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00032,C00359,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00359(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00359"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1507
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00359"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1+C00032(I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(s,REG
      C00359(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00359"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00348')
      RETURN
      END
      SUBROUTINE S00349(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00074,C00171,C00174,C00360,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00360(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00360"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1509
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00360"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-C00074(I00001,I00003,I00002)*C00174(I00001,I00003,I00002)*
     *  C00171(I00005,I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00360(I00005,I00002)=-RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00360"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00349')
      RETURN
      END
      SUBROUTINE S00350(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00074,C00347,C00361,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL C00361(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00361"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1511
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00361"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1-C00074(I00001,I00003,I00002)*C00347(I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(s,REG
      C00361(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00361"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00350')
      RETURN
      END
      SUBROUTINE S00351(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00074,C00347,C00362,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL C00362(SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00362"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1513
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00362"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      RS1=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-C00074(I00001,I00003,I00002)*C00347(I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      C00362(I00003,I00002)=-RS1
    1 CONTINUE  ! END (all,s,REG)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00362"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00351')
      RETURN
      END
      SUBROUTINE S00352(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00074,C00347,C00363,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL C00363(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00363"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1515
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00363"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-C00074(I00001,I00003,I00002)*C00347(I00001,I00003,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(s,REG
      C00363(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00363"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00352')
      RETURN
      END
      SUBROUTINE S00353(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00074,C00171,C00174,C00364,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00364(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00364"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1517
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00364"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00074(I00001,I00003,I00002)*C00174(I00001,I00003,I00002)*
     *  C00171(I00005,I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00364(I00005,I00002)=-RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00364"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00353')
      RETURN
      END
      SUBROUTINE S00354(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00171,C00174,C00365,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00365(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00365"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1519
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00365"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00008=1,SSZ(1)  ! SUM(k,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-C00033(I00001,I00008,I00002)*C00174(I00001,I00008,I00002)*
     *  C00171(I00005,I00001,I00008,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(k,REG
      C00365(I00005,I00002)=-RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00365"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00354')
      RETURN
      END
      SUBROUTINE S00355(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00347,C00366,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL C00366(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00366"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1521
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00366"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)  ! SUM(k,REG
      RS1=RS1-C00033(I00001,I00008,I00002)*C00347(I00001,I00008,I00002)
    3 CONTINUE  ! END SUM(k,REG
      C00366(I00001,I00002)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00366"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00355')
      RETURN
      END
      SUBROUTINE S00356(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00347,C00367,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL C00367(SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00367"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1523
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00367"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00008=1,SSZ(1)  ! (all,k,REG)
      RS1=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-C00033(I00001,I00008,I00002)*C00347(I00001,I00008,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      C00367(I00008,I00002)=-RS1
    1 CONTINUE  ! END (all,k,REG)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00367"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00356')
      RETURN
      END
      SUBROUTINE S00357(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00347,C00368,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL C00368(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00368"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1525
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00368"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00008=1,SSZ(1)  ! SUM(k,REG
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-C00033(I00001,I00008,I00002)*C00347(I00001,I00008,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(k,REG
      C00368(I00002)=-RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00368"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00357')
      RETURN
      END
      SUBROUTINE S00358(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00171,C00174,C00369,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00005
      INTEGER I00008
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00369(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00369"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1527
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00369"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00008=1,SSZ(1)  ! SUM(k,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00033(I00001,I00008,I00002)*C00174(I00001,I00008,I00002)*
     *  C00171(I00005,I00001,I00008,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(k,REG
      C00369(I00005,I00002)=-RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00369"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00358')
      RETURN
      END
      SUBROUTINE S00359(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00171,C00174,C00370,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00370(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00370"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1529
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00370"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-C00033(I00001,I00003,I00002)*C00174(I00001,I00003,I00002)*
     *  C00171(I00005,I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00370(I00005,I00002)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00370"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00359')
      RETURN
      END
      SUBROUTINE S00360(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00347,C00371,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL C00371(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00371"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1531
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00371"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS1=RS1-C00033(I00001,I00003,I00002)*C00347(I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(s,REG
      C00371(I00001,I00002)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00371"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00360')
      RETURN
      END
      SUBROUTINE S00361(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00347,C00372,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL C00372(SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00372"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1533
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00372"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      RS1=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-C00033(I00001,I00003,I00002)*C00347(I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      C00372(I00003,I00002)=RS1
    1 CONTINUE  ! END (all,s,REG)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00372"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00361')
      RETURN
      END
      SUBROUTINE S00362(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00347,C00373,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL C00373(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00373"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1535
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00373"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-C00033(I00001,I00003,I00002)*C00347(I00001,I00003,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(s,REG
      C00373(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00373"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00362')
      RETURN
      END
      SUBROUTINE S00363(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00171,C00174,C00374,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00374(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00374"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1537
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00374"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00033(I00001,I00003,I00002)*C00174(I00001,I00003,I00002)*
     *  C00171(I00005,I00001,I00003,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    4 CONTINUE  ! END SUM(s,REG
      C00374(I00005,I00002)=RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00374"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00363')
      RETURN
      END
      SUBROUTINE S00364(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00171,C00174,C00375,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00375(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00375"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1539
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00375"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1-C00033(I00001,I00002,I00003)*C00174(I00001,I00002,I00003)*
     *  C00171(I00005,I00001,I00002,I00003)
    4 CONTINUE  ! END SUM(r,REG
      C00375(I00005,I00001,I00003)=-RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00375"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00364')
      RETURN
      END
      SUBROUTINE S00365(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00347,C00376,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL C00376(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00376"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1541
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00376"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1-C00033(I00001,I00002,I00003)*C00347(I00001,I00002,I00003)
    3 CONTINUE  ! END SUM(r,REG
      C00376(I00001,I00003)=-RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00376"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00365')
      RETURN
      END
      SUBROUTINE S00366(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOCIG,
     *  C00033,C00171,C00174,C00377,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GSINC6
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1)
      INTEGER AXSUN
      CHARACTER*(*) DOCIG
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER MMEL,ELAD(MMNST),TGEPOS
      CHARACTER*(*) STELST(MMNST),STNM(MMNST),STEL(MMEL)
      REAL RS1
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00377(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'formula for coefficient "C00377"'
      CurrentAction2=
     *  'introduced during condensation'
      CurrentIGNO=1543
      CurrentIGTP='fm'
      CALL GPAPRW(
     *  ' before calculating formula for coefficient "C00377"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOCIG.EQ.'n') GOTO 9000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RS1=0.0
      DO 4 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00033(I00001,I00002,I00003)*C00174(I00001,I00002,I00003)*
     *  C00171(I00005,I00001,I00002,I00003)
    4 CONTINUE  ! END SUM(r,REG
      C00377(I00005,I00001,I00003)=-RS1
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating formula for coefficient "C00377"',
     *  'introduced during condensation',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00366')
      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(1501).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00356',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1501).NE.'n') then
      CALL S00345(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1501),
     *  C00160,C00171,C00174,C00356,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1503).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00357',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1503).NE.'n') then
      CALL S00346(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1503),
     *  C00160,C00347,C00357,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1505).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00358',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1505).NE.'n') then
      CALL S00347(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1505),
     *  C00160,C00171,C00174,C00358,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1507).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00359',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1507).NE.'n') then
      CALL S00348(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1507),
     *  C00032,C00359,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1509).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00360',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1509).NE.'n') then
      CALL S00349(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1509),
     *  C00074,C00171,C00174,C00360,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1511).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00361',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1511).NE.'n') then
      CALL S00350(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1511),
     *  C00074,C00347,C00361,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1513).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00362',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1513).NE.'n') then
      CALL S00351(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1513),
     *  C00074,C00347,C00362,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1515).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00363',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1515).NE.'n') then
      CALL S00352(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1515),
     *  C00074,C00347,C00363,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1517).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00364',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1517).NE.'n') then
      CALL S00353(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1517),
     *  C00074,C00171,C00174,C00364,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1519).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00365',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1519).NE.'n') then
      CALL S00354(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1519),
     *  C00033,C00171,C00174,C00365,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1521).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00366',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1521).NE.'n') then
      CALL S00355(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1521),
     *  C00033,C00347,C00366,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1523).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00367',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1523).NE.'n') then
      CALL S00356(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1523),
     *  C00033,C00347,C00367,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1525).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00368',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1525).NE.'n') then
      CALL S00357(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1525),
     *  C00033,C00347,C00368,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1527).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00369',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1527).NE.'n') then
      CALL S00358(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1527),
     *  C00033,C00171,C00174,C00369,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1529).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00370',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1529).NE.'n') then
      CALL S00359(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1529),
     *  C00033,C00171,C00174,C00370,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1531).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00371',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1531).NE.'n') then
      CALL S00360(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1531),
     *  C00033,C00347,C00371,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1533).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00372',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1533).NE.'n') then
      CALL S00361(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1533),
     *  C00033,C00347,C00372,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1535).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00373',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1535).NE.'n') then
      CALL S00362(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1535),
     *  C00033,C00347,C00373,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1537).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00374',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1537).NE.'n') then
      CALL S00363(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1537),
     *  C00033,C00171,C00174,C00374,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1539).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00375',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1539).NE.'n') then
      CALL S00364(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1539),
     *  C00033,C00171,C00174,C00375,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1541).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00376',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1541).NE.'n') then
      CALL S00365(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1541),
     *  C00033,C00347,C00376,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      IF(ECHO1.AND.DOIG(1543).EQ.'y') THEN
        CALL GPTO1(' Formula for ''%t''',
     *    'C00377',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(DOIG(1543).NE.'n') then
      CALL S00366(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,ELAD,STELST,STNM,MMEL,STEL,
     *  SSMPST,AXSUN,
     *  DOIG(1543),
     *  C00033,C00171,C00174,C00377,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ELSE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ENDIF
      RETURN
15000 CALL PERET('M00012')
      RETURN
      END
      SUBROUTINE S00368(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "GHHLDDOM"'
      CurrentIGNO=348
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=C00076(I00001)*C00086(I00001,I00003)-C00076(I00001)*(1  -
     *  C00090(I00001,I00003))*C00086(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(5),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00368')
      RETURN
      END
      SUBROUTINE S00369(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "GHHLDDOM"'
      CurrentIGNO=348
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=C00076(I00001)*C00086(I00001,I00003)-C00076(I00001)*(1  -
     *  C00090(I00001,I00003))*C00086(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(5),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00369')
      RETURN
      END
      SUBROUTINE S00370(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "GHHLDDOM"'
      CurrentIGNO=348
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=-C00076(I00001)*C00090(I00001,I00003)*C00088(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(5),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00370')
      RETURN
      END
      SUBROUTINE S00371(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "GHHLDDOM"'
      CurrentIGNO=348
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=-C00076(I00001)*C00090(I00001,I00003)*C00088(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(5),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00371')
      RETURN
      END
      SUBROUTINE S00372(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00087,C00089,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "GHHLDDOM"'
      CurrentIGNO=348
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=C00076(I00001)*100.0 *C00087(I00001,I00003)+C00076(I00001)*
     *  (-C00090(I00001,I00003)*100.0 *C00089(I00001,I00003)-(1  -
     *  C00090(I00001,I00003))*100.0 *C00087(I00001,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(5),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00372')
      RETURN
      END
      SUBROUTINE S00373(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "GHHLDDOM"'
      CurrentIGNO=348
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+I00001)+SSZ(19)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(5),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "GHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00373')
      RETURN
      END
      SUBROUTINE S00375(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00065,C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "TGCRATIO"'
      CurrentIGNO=349
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-(C00063(I00001,I00002)+C00065(I00001,I00002)*
     *  C00076(I00001)*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(6),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00375')
      RETURN
      END
      SUBROUTINE S00376(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00011,C00065,C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00011(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "TGCRATIO"'
      CurrentIGNO=349
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-(C00011(I00001,I00002)+C00065(I00001,I00002)*
     *  C00076(I00001)*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(6),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00376')
      RETURN
      END
      SUBROUTINE S00377(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "TGCRATIO"'
      CurrentIGNO=349
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00065(I00001,I00002)*(1.0-(C00076(I00001)*
     *  C00088(I00001,I00002)-C00076(I00001)*C00090(I00001,I00002)*
     *  C00088(I00001,I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(6),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00377')
      RETURN
      END
      SUBROUTINE S00378(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00014,C00065,C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00014(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "TGCRATIO"'
      CurrentIGNO=349
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-(C00014(I00001,I00002)-C00065(I00001,I00002)*
     *  (C00076(I00001)*C00088(I00001,I00002)-C00076(I00001)*
     *  C00090(I00001,I00002)*C00088(I00001,I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(6),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00378')
      RETURN
      END
      SUBROUTINE S00379(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00257,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00257(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "TGCRATIO"'
      CurrentIGNO=349
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00257(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(6),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "del_taxrgc"'
      CurrentAction2=
     *  ' in equation "TGCRATIO"'
      CurrentIGNO=349
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrgc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       60)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(60),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(6),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "del_taxrgc"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00381')
      RETURN
      END
      SUBROUTINE S00382(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "TGCRATIO"'
      CurrentIGNO=349
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00065(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+I00001)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(6),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "TGCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00382')
      RETURN
      END
      SUBROUTINE S00383(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PGTEQ"'
      CurrentIGNO=351
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=(1  -C00090(I00001,I00002))*C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(7),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00383')
      RETURN
      END
      SUBROUTINE S00384(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "PGTEQ"'
      CurrentIGNO=351
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=(1  -C00090(I00001,I00002))*C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(7),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00384')
      RETURN
      END
      SUBROUTINE S00385(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "PGTEQ"'
      CurrentIGNO=351
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00090(I00001,I00002)*C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(7),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "PGTEQ"'
      CurrentIGNO=351
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00090(I00001,I00002)*C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(7),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00386')
      RETURN
      END
      SUBROUTINE S00387(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00087,C00089,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "PGTEQ"'
      CurrentIGNO=351
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-(-C00090(I00001,I00002)*100.0 *C00089(I00001,I00002)-(1  -
     *  C00090(I00001,I00002))*100.0 *C00087(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(7),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00387')
      RETURN
      END
      SUBROUTINE S00388(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pg"'
      CurrentAction2=
     *  ' in equation "PGTEQ"'
      CurrentIGNO=351
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pg"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pg',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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+I00001)+SSZ(19)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(7),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pg"',
     *  ' in equation "PGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00388')
      RETURN
      END
      SUBROUTINE S00389(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00092,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00092(SSZ(21),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pg"'
      CurrentAction2=
     *  ' in equation "ENYGPRICE"'
      CurrentIGNO=367
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pg"',
     *  ' in equation "ENYGPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       69)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+1)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 3 I00008=1,SSZ(21)  ! (all,k,ENY_GCOMM)
      ENTRY=-C00092(I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+SSMP(SSMPST(21)-1+I00008))+SSZ(19)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(9),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pg"',
     *  ' in equation "ENYGPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00093,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00093(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pg"'
      CurrentAction2=
     *  ' in equation "ENYGDEMAND"'
      CurrentIGNO=370
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pg"',
     *  ' in equation "ENYGDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       69)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(21)  ! (all,i,ENY_GCOMM)
      RWN=I00001+SSZ(21)*(I00002-1)
      ENTRY=C00093(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+SSMP(SSMPST(21)-1+I00001))+SSZ(19)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00093(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+1)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(10),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pg"',
     *  ' in equation "ENYGDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00390')
      RETURN
      END
      SUBROUTINE S00391(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "ENYGDEMAND"'
      CurrentIGNO=370
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "ENYGDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(21)  ! (all,i,ENY_GCOMM)
      RWN=I00001+SSZ(21)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+SSMP(SSMPST(21)-1+I00001))+SSZ(19)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(22)-1+1)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(10),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "ENYGDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00391')
      RETURN
      END
      SUBROUTINE S00392(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00095(SSZ(23),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pg"'
      CurrentAction2=
     *  ' in equation "NENYGPRICE"'
      CurrentIGNO=382
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pg"',
     *  ' in equation "NENYGPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       69)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(24)-1+1)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 3 I00008=1,SSZ(23)  ! (all,k,NENY_GCOMM)
      ENTRY=-C00095(I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+SSMP(SSMPST(23)-1+I00008))+SSZ(19)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(11),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pg"',
     *  ' in equation "NENYGPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00392')
      RETURN
      END
      SUBROUTINE S00393(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pg"'
      CurrentAction2=
     *  ' in equation "NENYGDEMAND"'
      CurrentIGNO=385
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pg"',
     *  ' in equation "NENYGDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       69)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(23)  ! (all,i,NENY_GCOMM)
      RWN=I00001+SSZ(23)*(I00002-1)
      ENTRY=C00096(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+SSMP(SSMPST(23)-1+I00001))+SSZ(19)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00096(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(24)-1+1)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(12),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pg"',
     *  ' in equation "NENYGDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "NENYGDEMAND"'
      CurrentIGNO=385
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "NENYGDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(23)  ! (all,i,NENY_GCOMM)
      RWN=I00001+SSZ(23)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+SSMP(SSMPST(23)-1+I00001))+SSZ(19)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(24)-1+1)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(12),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "NENYGDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,C00084,C00097,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00011
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00049(SSZ(1))
      REAL C00084(SSZ(19),SSZ(1))
      REAL C00097(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pg"'
      CurrentAction2=
     *  ' in equation "GOVDMNDS"'
      CurrentIGNO=391
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pg"',
     *  ' in equation "GOVDMNDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       69)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(25)  ! (all,i,UG_COMM)
      RWN=I00001+SSZ(25)*(I00002-1)
      ENTRY=C00097(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00001)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 4 I00011=1,SSZ(25)  ! (all,XX01,UG_COMM)
      RS1=-C00097(I00002)*C00084(SSMP(SSMPST(25)-1+I00011),I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=3
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
         ErrorIndName(2)='i           '
         ErrorIndVal(2)=I00001
         ErrorIndSetNo(2)=25
         ErrorIndName(3)='XX01        '
         ErrorIndVal(3)=I00011
         ErrorIndSetNo(3)=25
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00011)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(69),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(14),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pg"',
     *  ' in equation "GOVDMNDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "GOVDMNDS"'
      CurrentIGNO=391
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "GOVDMNDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(25)  ! (all,i,UG_COMM)
      RWN=I00001+SSZ(25)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00001)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(14),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "GOVDMNDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00398')
      RETURN
      END
      SUBROUTINE S00402(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      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 C00049(SSZ(1))
      REAL C00084(SSZ(19),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pg"'
      CurrentAction2=
     *  ' in equation "GOVU"'
      CurrentIGNO=392
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pg"',
     *  ' in equation "GOVU"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pg',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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(25)  ! (all,i,UG_COMM)
      RS1=-C00084(SSMP(SSMPST(25)-1+I00001),I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
         ErrorIndName(2)='i           '
         ErrorIndVal(2)=I00001
         ErrorIndSetNo(2)=25
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00001)+SSZ(19)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(15),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pg"',
     *  ' in equation "GOVU"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00402')
      RETURN
      END
      SUBROUTINE S00409(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00060,C00076,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "TPCRATIO"'
      CurrentIGNO=426
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00058(I00001,I00002)-C00060(I00001,I00002)*C00076(I00001)*
     *  (1  -C00104(I00001,I00002))*C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00409')
      RETURN
      END
      SUBROUTINE S00410(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00076,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "TPCRATIO"'
      CurrentIGNO=426
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00060(I00001,I00002)*(1.0-C00076(I00001)*
     *  C00102(I00001,I00002))-C00060(I00001,I00002)*C00076(I00001)*
     *  C00104(I00001,I00002)*C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00410')
      RETURN
      END
      SUBROUTINE S00412(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00017,C00060,C00076,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00017(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "TPCRATIO"'
      CurrentIGNO=426
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00017(I00001,I00002)-C00060(I00001,I00002)*C00076(I00001)*
     *  (1  -C00104(I00001,I00002))*C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(13),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00020,C00060,C00076,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "TPCRATIO"'
      CurrentIGNO=426
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-(C00020(I00001,I00002)-C00060(I00001,I00002)*
     *  C00076(I00001)*C00102(I00001,I00002))-C00060(I00001,I00002)*
     *  C00076(I00001)*C00104(I00001,I00002)*C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00268,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00268(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "TPCRATIO"'
      CurrentIGNO=426
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00268(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "del_taxrpc"'
      CurrentAction2=
     *  ' in equation "TPCRATIO"'
      CurrentIGNO=426
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrpc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       61)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(61),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),COLBF(61),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "del_taxrpc"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "TPCRATIO"'
      CurrentIGNO=426
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00060(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(27)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(20),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "TPCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00417')
      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''',
     *    '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(5),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 S00368(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00369(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00370(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00371(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00372(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00087,C00089,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00373(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),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''',
     *    '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(6),COLBF(4),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00063,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00375(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00065,C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00376(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00011,C00065,C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00377(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00378(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00014,C00065,C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00379(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00257,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(6),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00067,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00381(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(60),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00382(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'PGTEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00383(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00384(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00385(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00386(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00387(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00087,C00089,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00388(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(69),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''',
     *    'ENYGPRICE',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,AXSUN,
     *  KSTEP,SMND(69),KZC,DOEQ,STRHS,STRHNZ,
     *  C00092,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'ENYGDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00390(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(69),KZC,DOEQ,STRHS,STRHNZ,
     *  C00093,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00391(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'NENYGPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00392(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(69),KZC,DOEQ,STRHS,STRHNZ,
     *  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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'NENYGDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00393(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(69),KZC,DOEQ,STRHS,STRHNZ,
     *  C00096,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00394(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GOVDMNDS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(14),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(49),ECHO1,
     *  ROWBF(14),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00397(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(69),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,C00084,C00097,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00398(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),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''',
     *    'GOVU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(15),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(48),ECHO1,
     *  ROWBF(15),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(15),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00402(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(69),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,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''',
     *    'TPDSHIFT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(13),ECHO1,
     *  ROWBF(16),COLBF(13),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(77),ECHO1,
     *  ROWBF(16),COLBF(77),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(16),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TPMSHIFT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(16),ECHO1,
     *  ROWBF(18),COLBF(16),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(77),ECHO1,
     *  ROWBF(18),COLBF(77),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(79),ECHO1,
     *  ROWBF(18),COLBF(79),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00409(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00060,C00076,C00100,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 S00410(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00076,C00102,C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(12),ECHO1,
     *  ROWBF(20),COLBF(12),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00058,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00412(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00017,C00060,C00076,C00100,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 S00413(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00020,C00060,C00076,C00102,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 S00414(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00268,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(20),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00062,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00416(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(61),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00417(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00013')
      RETURN
      END
      SUBROUTINE S00418(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PHHLDDOM"'
      CurrentIGNO=430
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=C00076(I00001)*C00100(I00001,I00003)-C00076(I00001)*(1  -
     *  C00104(I00001,I00003))*C00100(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(22),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "PHHLDDOM"'
      CurrentIGNO=430
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=-C00076(I00001)*C00104(I00001,I00003)*C00102(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(22),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00419')
      RETURN
      END
      SUBROUTINE S00421(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "PHHLDDOM"'
      CurrentIGNO=430
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=C00076(I00001)*C00100(I00001,I00003)-C00076(I00001)*(1  -
     *  C00104(I00001,I00003))*C00100(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(22),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "PHHLDDOM"'
      CurrentIGNO=430
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=-C00076(I00001)*C00104(I00001,I00003)*C00102(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(22),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00101,C00103,C00104,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "PHHLDDOM"'
      CurrentIGNO=430
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=C00076(I00001)*100.0 *C00101(I00001,I00003)+C00076(I00001)*
     *  (-C00104(I00001,I00003)*100.0 *C00103(I00001,I00003)-(1  -
     *  C00104(I00001,I00003))*100.0 *C00101(I00001,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(22),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "PHHLDDOM"'
      CurrentIGNO=430
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       74)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(27)*(I00003-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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(22),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "PHHLDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PPTEQ"'
      CurrentIGNO=433
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=(1  -C00104(I00001,I00002))*C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(24),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "PPTEQ"'
      CurrentIGNO=433
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00104(I00001,I00002)*C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(24),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "PPTEQ"'
      CurrentIGNO=433
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=(1  -C00104(I00001,I00002))*C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(24),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "PPTEQ"'
      CurrentIGNO=433
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00104(I00001,I00002)*C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(24),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00101,C00103,C00104,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "PPTEQ"'
      CurrentIGNO=433
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-(-C00104(I00001,I00002)*100.0 *C00103(I00001,I00002)-(1  -
     *  C00104(I00001,I00002))*100.0 *C00101(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(24),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pp"'
      CurrentAction2=
     *  ' in equation "PPTEQ"'
      CurrentIGNO=433
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       73)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(27)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(73),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(24),COLBF(73),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "PPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00106(SSZ(29),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pp"'
      CurrentAction2=
     *  ' in equation "ENYPPRICE"'
      CurrentIGNO=447
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "ENYPPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       73)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+1)+SSZ(27)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(73),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 3 I00008=1,SSZ(29)  ! (all,k,ENY_PCOMM)
      ENTRY=-C00106(I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(30)-1+I00008))+SSZ(27)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(73),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(26),COLBF(73),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "ENYPPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00107,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00107(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pp"'
      CurrentAction2=
     *  ' in equation "ENYPDEMAND"'
      CurrentIGNO=450
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "ENYPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       73)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(29)  ! (all,i,ENY_PCOMM)
      RWN=I00001+SSZ(29)*(I00002-1)
      ENTRY=C00107(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(30)-1+I00001))+SSZ(27)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(73),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00107(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+1)+SSZ(27)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(73),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(27),COLBF(73),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "ENYPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "ENYPDEMAND"'
      CurrentIGNO=450
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "ENYPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       74)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(29)  ! (all,i,ENY_PCOMM)
      RWN=I00001+SSZ(29)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(30)-1+I00001))+SSZ(27)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(74),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(27)-1+1)+SSZ(27)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(74),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(27),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "ENYPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00113,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00113(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pop"'
      CurrentAction2=
     *  ' in equation "PRIVDMNDS"'
      CurrentIGNO=475
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "PRIVDMNDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RWN=I00001+SSZ(32)*(I00002-1)
      ENTRY=-1.0+C00113(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(28),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "PRIVDMNDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00434')
      RETURN
      END
      SUBROUTINE S00436(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00114(SSZ(32),SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pp"'
      CurrentAction2=
     *  ' in equation "PRIVDMNDS"'
      CurrentIGNO=475
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "PRIVDMNDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       73)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RWN=I00001+SSZ(32)*(I00002-1)
      DO 3 I00008=1,SSZ(32)  ! (all,k,UP_COMM)
      ENTRY=-C00114(I00001,I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(34)-1+I00008)+SSZ(27)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(73),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(28),COLBF(73),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "PRIVDMNDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00436')
      RETURN
      END
      SUBROUTINE S00437(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "PRIVDMNDS"'
      CurrentIGNO=475
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "PRIVDMNDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RWN=I00001+SSZ(32)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(34)-1+I00001)+SSZ(27)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(28),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "PRIVDMNDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00437')
      RETURN
      END
      SUBROUTINE S00439(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00110,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00110(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pp"'
      CurrentAction2=
     *  ' in equation "PHHLDINDEX"'
      CurrentIGNO=476
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "PHHLDINDEX"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       73)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      ENTRY=-C00110(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(34)-1+I00001)+SSZ(27)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(73),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(29),COLBF(73),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "PHHLDINDEX"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00439')
      RETURN
      END
      SUBROUTINE S00445(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00115,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      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 C00115(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "yp"'
      CurrentAction2=
     *  ' in equation "UTILELASPRIV"'
      CurrentIGNO=480
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yp"',
     *  ' in equation "UTILELASPRIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       52)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=0.0
      DO 2 I00001=1,SSZ(32)  ! SUM(i,UP_COMM
      RS1=RS1-C00115(I00001,I00002)
    2 CONTINUE  ! END SUM(i,UP_COMM
      ENTRY=-RS1
      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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(31),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "yp"',
     *  ' in equation "UTILELASPRIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00445')
      RETURN
      END
      SUBROUTINE S00446(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00115,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00115(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pp"'
      CurrentAction2=
     *  ' in equation "UTILELASPRIV"'
      CurrentIGNO=480
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pp"',
     *  ' in equation "UTILELASPRIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       73)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      ENTRY=-C00115(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(34)-1+I00001)+SSZ(27)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(73),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(31),COLBF(73),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pp"',
     *  ' in equation "UTILELASPRIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00446')
      RETURN
      END
      SUBROUTINE S00447(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00115,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00115(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "UTILELASPRIV"'
      CurrentIGNO=480
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "UTILELASPRIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      ENTRY=-C00115(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(34)-1+I00001)+SSZ(27)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(31),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "UTILELASPRIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "MPFACTPRICE"'
      CurrentIGNO=497
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "MPFACTPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(11)  ! (all,i,ENDWM_COMM)
      RWN=I00001+SSZ(11)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(32),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "MPFACTPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pfe"'
      CurrentAction2=
     *  ' in equation "MPFACTPRICE"'
      CurrentIGNO=497
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfe"',
     *  ' in equation "MPFACTPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       19)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(11)  ! (all,i,ENDWM_COMM)
      RWN=I00001+SSZ(11)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(11)-1+I00001)+SSZ(6)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(19),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(32),COLBF(19),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pfe"',
     *  ' in equation "MPFACTPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pfe"'
      CurrentAction2=
     *  ' in equation "SPFACTPRICE"'
      CurrentIGNO=498
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pfe"',
     *  ' in equation "SPFACTPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pfe',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       19)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(10)  ! (all,i,ENDWS_COMM)
      RWN=I00001+SSZ(10)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(6)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(19),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(33),COLBF(19),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pfe"',
     *  ' in equation "SPFACTPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00450')
      RETURN
      END
      SUBROUTINE S00452(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00319,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00319(SSZ(11),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "TFURATIO"'
      CurrentIGNO=499
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TFURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(11)  ! (all,i,ENDWM_COMM)
      ENTRY=C00319(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(34),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TFURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pmes"'
      CurrentAction2=
     *  ' in equation "TFURATIO"'
      CurrentIGNO=499
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pmes"',
     *  ' in equation "TFURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmes',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 2 I00001=1,SSZ(10)  ! (all,i,ENDWS_COMM)
      ENTRY=-C00068(SSMP(SSMPST(10)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(10)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(34),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pmes"',
     *  ' in equation "TFURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00453')
      RETURN
      END
      SUBROUTINE S00455(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "del_taxrfu"'
      CurrentAction2=
     *  ' in equation "TFURATIO"'
      CurrentIGNO=499
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrfu',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       63)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(63),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(34),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "del_taxrfu"',
     *  ' in equation "TFURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "TFURATIO"'
      CurrentIGNO=499
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "TFURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 4 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(11)  ! (all,i,ENDWM_COMM)
      ENTRY=-C00068(SSMP(SSMPST(11)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
    4 CONTINUE
      DO 6 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 5 I00001=1,SSZ(10)  ! (all,i,ENDWS_COMM)
      ENTRY=-C00068(SSMP(SSMPST(10)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(34),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "TFURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00279,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00279(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "TIURATIO"'
      CurrentIGNO=518
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TIURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00279(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TIURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00457')
      RETURN
      END
      SUBROUTINE S00460(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00025,C00055,C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00025(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfd"'
      CurrentAction2=
     *  ' in equation "TIURATIO"'
      CurrentIGNO=518
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "TIURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       23)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-(C00025(I00001,I00004,I00002)+C00055(I00001,I00004,I00002)*
     *  C00076(I00001)*(1  -C00123(I00001,I00004,I00002))*
     *  C00119(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "TIURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,C00055,C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfm"'
      CurrentAction2=
     *  ' in equation "TIURATIO"'
      CurrentIGNO=518
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "TIURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       26)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-(C00027(I00001,I00004,I00002)-C00055(I00001,I00004,I00002)*
     *  (C00076(I00001)*C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002)))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(26),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),COLBF(26),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "TIURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00281,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00281(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "TIURATIO"'
      CurrentIGNO=518
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TIURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00281(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TIURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00462')
      RETURN
      END
      SUBROUTINE S00464(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "del_taxriu"'
      CurrentAction2=
     *  ' in equation "TIURATIO"'
      CurrentIGNO=518
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxriu',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       62)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(62),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(37),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "del_taxriu"',
     *  ' in equation "TIURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "TIURATIO"'
      CurrentIGNO=518
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "TIURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00055(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "TIURATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "INDDOM"'
      CurrentIGNO=523
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
      ENTRY=C00076(I00001)*C00119(I00001,I00004,I00003)-C00076(I00001)*
     *  (1  -C00123(I00001,I00004,I00003))*C00119(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "INDDOM"'
      CurrentIGNO=523
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
      ENTRY=-C00076(I00001)*C00123(I00001,I00004,I00003)*
     *  C00121(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(40),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00467')
      RETURN
      END
      SUBROUTINE S00469(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfd"'
      CurrentAction2=
     *  ' in equation "INDDOM"'
      CurrentIGNO=523
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       23)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
      ENTRY=C00076(I00001)*C00119(I00001,I00004,I00003)-C00076(I00001)*
     *  (1  -C00123(I00001,I00004,I00003))*C00119(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(40),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfm"'
      CurrentAction2=
     *  ' in equation "INDDOM"'
      CurrentIGNO=523
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       26)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
      ENTRY=-C00076(I00001)*C00123(I00001,I00004,I00003)*
     *  C00121(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(26),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(40),COLBF(26),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00120,C00122,C00123,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "INDDOM"'
      CurrentIGNO=523
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
      ENTRY=C00076(I00001)*100.0 *C00120(I00001,I00004,I00003)+
     *  C00076(I00001)*(-C00123(I00001,I00004,I00003)*100.0 *
     *  C00122(I00001,I00004,I00003)-(1  -C00123(I00001,I00004,I00003))*
     *  100.0 *C00120(I00001,I00004,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(40),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "INDDOM"'
      CurrentIGNO=523
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(I00003-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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "INDDOM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00472')
      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''',
     *    'PHHLDDOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00418(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00100,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 S00419(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00102,C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(12),ECHO1,
     *  ROWBF(22),COLBF(12),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00421(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00100,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 S00422(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00102,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 S00423(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00101,C00103,C00104,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(74),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''',
     *    'PPTEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00425(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00100,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 S00426(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,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 S00427(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00100,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 S00428(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00102,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 S00429(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00101,C00103,C00104,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(73),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''',
     *    'ENYPPRICE',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,AXSUN,
     *  KSTEP,SMND(73),KZC,DOEQ,STRHS,STRHNZ,
     *  C00106,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'ENYPDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00432(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(73),KZC,DOEQ,STRHS,STRHNZ,
     *  C00107,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00433(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVDMNDS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00434(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00113,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(52),ECHO1,
     *  ROWBF(28),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(32),SSZ(1),1,1,1,1,1,C00113,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00436(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(73),KZC,DOEQ,STRHS,STRHNZ,
     *  C00114,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00437(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),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''',
     *    'PHHLDINDEX',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(50),ECHO1,
     *  ROWBF(29),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00439(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(73),KZC,DOEQ,STRHS,STRHNZ,
     *  C00110,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVATEU',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(30),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(50),ECHO1,
     *  ROWBF(30),COLBF(50),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(52),ECHO1,
     *  ROWBF(30),COLBF(52),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(53),ECHO1,
     *  ROWBF(30),COLBF(53),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00080,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'UTILELASPRIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(51),ECHO1,
     *  ROWBF(31),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00445(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(52),KZC,DOEQ,STRHS,STRHNZ,
     *  C00115,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00446(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(73),KZC,DOEQ,STRHS,STRHNZ,
     *  C00115,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00447(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),KZC,DOEQ,STRHS,STRHNZ,
     *  C00115,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MPFACTPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00448(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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 S00449(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(19),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'SPFACTPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00450(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(19),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(27),ECHO1,
     *  ROWBF(33),COLBF(27),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TFURATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00452(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00319,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(34),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00069,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00455(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(63),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00456(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TIURATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00457(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00279,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(37),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00280,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(37),COLBF(22),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00053,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00460(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00025,C00055,C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00461(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(26),KZC,DOEQ,STRHS,STRHNZ,
     *  C00027,C00055,C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00462(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00281,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(37),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00057,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00464(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(62),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00465(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'INDDOM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00466(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00467(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(22),ECHO1,
     *  ROWBF(40),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 S00469(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00470(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(26),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00471(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00120,C00122,C00123,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00472(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      RETURN
15000 CALL PERET('M00014')
      RETURN
      END
      SUBROUTINE S00474(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "PFEEQ"'
      CurrentIGNO=525
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "PFEEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RWN=I00001+SSZ(6)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(I00002-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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(41),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "PFEEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00474')
      RETURN
      END
      SUBROUTINE S00475(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PFTEQ"'
      CurrentIGNO=526
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(1  -C00123(I00001,I00004,I00002))*
     *  C00119(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00475')
      RETURN
      END
      SUBROUTINE S00476(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "PFTEQ"'
      CurrentIGNO=526
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(42),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfd"'
      CurrentAction2=
     *  ' in equation "PFTEQ"'
      CurrentIGNO=526
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       23)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(1  -C00123(I00001,I00004,I00002))*
     *  C00119(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(42),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00477')
      RETURN
      END
      SUBROUTINE S00478(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfm"'
      CurrentAction2=
     *  ' in equation "PFTEQ"'
      CurrentIGNO=526
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       26)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(26),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(42),COLBF(26),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00478')
      RETURN
      END
      SUBROUTINE S00479(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00120,C00122,C00123,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "PFTEQ"'
      CurrentIGNO=526
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-C00123(I00001,I00004,I00002)*100.0 *
     *  C00122(I00001,I00004,I00002)-(1  -C00123(I00001,I00004,I00002))*
     *  100.0 *C00120(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(42),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "PFTEQ"'
      CurrentIGNO=526
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(I00002-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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(42),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "PFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00125,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00125(SSZ(36),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "NCOALFPRICE"'
      CurrentIGNO=545
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "NCOALFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(39)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 4 I00008=1,SSZ(36)  ! (all,k,NCOAL_FCOMM)
      ENTRY=-C00125(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(46),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "NCOALFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00125,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00125(SSZ(36),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "NCOALFPRICE"'
      CurrentIGNO=545
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "NCOALFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(36)  ! (all,k,NCOAL_FCOMM)
      ENTRY=C00125(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(46),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "NCOALFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00482')
      RETURN
      END
      SUBROUTINE S00485(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00125,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00125(SSZ(36),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "NCOALFPRICE"'
      CurrentIGNO=545
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "NCOALFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(36)  ! (all,k,NCOAL_FCOMM)
      ENTRY=C00125(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(46),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "NCOALFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00485')
      RETURN
      END
      SUBROUTINE S00486(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00126,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "NCOALFDEMAND"'
      CurrentIGNO=548
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(36)  ! (all,i,NCOAL_FCOMM)
      RWN=I00001+SSZ(36)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00126(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00126(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(39)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "NCOALFDEMAND"'
      CurrentIGNO=548
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(36)  ! (all,i,NCOAL_FCOMM)
      RWN=I00001+SSZ(36)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(39)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "NCOALFDEMAND"'
      CurrentIGNO=548
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(36)  ! (all,i,NCOAL_FCOMM)
      RWN=I00001+SSZ(36)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00126(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afsec"'
      CurrentAction2=
     *  ' in equation "NCOALFDEMAND"'
      CurrentIGNO=548
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       88)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(36)  ! (all,i,NCOAL_FCOMM)
      RWN=I00001+SSZ(36)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00126(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afreg"'
      CurrentAction2=
     *  ' in equation "NCOALFDEMAND"'
      CurrentIGNO=548
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       89)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(36)  ! (all,i,NCOAL_FCOMM)
      RWN=I00001+SSZ(36)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00126(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "NCOALFDEMAND"'
      CurrentIGNO=548
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(36)  ! (all,i,NCOAL_FCOMM)
      RWN=I00001+SSZ(36)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00126(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(38)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(47),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "NCOALFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00491')
      RETURN
      END
      SUBROUTINE S00492(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(38),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "NELYFPRICE"'
      CurrentIGNO=560
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "NELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(41)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 4 I00008=1,SSZ(38)  ! (all,k,NELY_FCOMM)
      ENTRY=-C00128(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(40)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "NELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00492')
      RETURN
      END
      SUBROUTINE S00493(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(38),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "NELYFPRICE"'
      CurrentIGNO=560
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "NELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(38)  ! (all,k,NELY_FCOMM)
      ENTRY=C00128(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(40)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "NELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00493')
      RETURN
      END
      SUBROUTINE S00496(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(38),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "NELYFPRICE"'
      CurrentIGNO=560
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "NELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(38)  ! (all,k,NELY_FCOMM)
      ENTRY=C00128(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(40)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(48),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "NELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00496')
      RETURN
      END
      SUBROUTINE S00497(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00129(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "NELYFDEMAND"'
      CurrentIGNO=563
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(38)  ! (all,i,NELY_FCOMM)
      RWN=I00001+SSZ(38)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00129(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(40)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00129(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(41)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "NELYFDEMAND"'
      CurrentIGNO=563
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(38)  ! (all,i,NELY_FCOMM)
      RWN=I00001+SSZ(38)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(40)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(41)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00498')
      RETURN
      END
      SUBROUTINE S00499(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00129(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "NELYFDEMAND"'
      CurrentIGNO=563
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(38)  ! (all,i,NELY_FCOMM)
      RWN=I00001+SSZ(38)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00129(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(40)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00499')
      RETURN
      END
      SUBROUTINE S00500(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00129(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afsec"'
      CurrentAction2=
     *  ' in equation "NELYFDEMAND"'
      CurrentIGNO=563
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       88)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(38)  ! (all,i,NELY_FCOMM)
      RWN=I00001+SSZ(38)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00129(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00129(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afreg"'
      CurrentAction2=
     *  ' in equation "NELYFDEMAND"'
      CurrentIGNO=563
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       89)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(38)  ! (all,i,NELY_FCOMM)
      RWN=I00001+SSZ(38)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00129(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00501')
      RETURN
      END
      SUBROUTINE S00502(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00129(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "NELYFDEMAND"'
      CurrentIGNO=563
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(38)  ! (all,i,NELY_FCOMM)
      RWN=I00001+SSZ(38)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00129(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(40)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(49),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "NELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00502')
      RETURN
      END
      SUBROUTINE S00503(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00131,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00131(SSZ(40),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "ENYFPRICE"'
      CurrentIGNO=574
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "ENYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(43)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 4 I00008=1,SSZ(40)  ! (all,k,ENY_FCOMM)
      ENTRY=-C00131(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(42)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(50),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "ENYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00131(SSZ(40),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "ENYFPRICE"'
      CurrentIGNO=574
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "ENYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(40)  ! (all,k,ENY_FCOMM)
      ENTRY=C00131(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(42)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(50),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "ENYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00504')
      RETURN
      END
      SUBROUTINE S00507(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00131(SSZ(40),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "ENYFPRICE"'
      CurrentIGNO=574
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "ENYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(40)  ! (all,k,ENY_FCOMM)
      ENTRY=C00131(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(42)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(50),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "ENYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00507')
      RETURN
      END
      SUBROUTINE S00508(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00132(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "ENYFDEMAND"'
      CurrentIGNO=577
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(40)  ! (all,i,ENY_FCOMM)
      RWN=I00001+SSZ(40)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00132(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(42)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00132(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(43)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(51),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00508')
      RETURN
      END
      SUBROUTINE S00509(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "ENYFDEMAND"'
      CurrentIGNO=577
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(40)  ! (all,i,ENY_FCOMM)
      RWN=I00001+SSZ(40)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(42)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(43)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(51),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00509')
      RETURN
      END
      SUBROUTINE S00510(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00132(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "ENYFDEMAND"'
      CurrentIGNO=577
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(40)  ! (all,i,ENY_FCOMM)
      RWN=I00001+SSZ(40)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00132(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(42)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(51),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00510')
      RETURN
      END
      SUBROUTINE S00511(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00132(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afsec"'
      CurrentAction2=
     *  ' in equation "ENYFDEMAND"'
      CurrentIGNO=577
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       88)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(40)  ! (all,i,ENY_FCOMM)
      RWN=I00001+SSZ(40)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00132(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(51),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00132(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afreg"'
      CurrentAction2=
     *  ' in equation "ENYFDEMAND"'
      CurrentIGNO=577
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       89)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(40)  ! (all,i,ENY_FCOMM)
      RWN=I00001+SSZ(40)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00132(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(51),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00512')
      RETURN
      END
      SUBROUTINE S00513(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00132(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "ENYFDEMAND"'
      CurrentIGNO=577
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(40)  ! (all,i,ENY_FCOMM)
      RWN=I00001+SSZ(40)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00132(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(42)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(51),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "ENYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00513')
      RETURN
      END
      SUBROUTINE S00514(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(41),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "KENFPRICE"'
      CurrentIGNO=589
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "KENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(45)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 4 I00008=1,SSZ(41)  ! (all,k,KEN_FCOMM)
      ENTRY=-C00134(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(44)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(52),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "KENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(41),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "KENFPRICE"'
      CurrentIGNO=589
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "KENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(41)  ! (all,k,KEN_FCOMM)
      ENTRY=C00134(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(44)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(52),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "KENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00515')
      RETURN
      END
      SUBROUTINE S00518(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00134(SSZ(41),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "KENFPRICE"'
      CurrentIGNO=589
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "KENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(41)  ! (all,k,KEN_FCOMM)
      ENTRY=C00134(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(44)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(52),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "KENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00135,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "KENFDEMAND"'
      CurrentIGNO=592
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(41)  ! (all,i,KEN_FCOMM)
      RWN=I00001+SSZ(41)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00135(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(44)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00135(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(45)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(53),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00519')
      RETURN
      END
      SUBROUTINE S00520(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "KENFDEMAND"'
      CurrentIGNO=592
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(41)  ! (all,i,KEN_FCOMM)
      RWN=I00001+SSZ(41)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(44)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(45)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(53),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00520')
      RETURN
      END
      SUBROUTINE S00521(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "KENFDEMAND"'
      CurrentIGNO=592
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(41)  ! (all,i,KEN_FCOMM)
      RWN=I00001+SSZ(41)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00135(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(44)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(53),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afsec"'
      CurrentAction2=
     *  ' in equation "KENFDEMAND"'
      CurrentIGNO=592
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       88)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(41)  ! (all,i,KEN_FCOMM)
      RWN=I00001+SSZ(41)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00135(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00522')
      RETURN
      END
      SUBROUTINE S00523(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afreg"'
      CurrentAction2=
     *  ' in equation "KENFDEMAND"'
      CurrentIGNO=592
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       89)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(41)  ! (all,i,KEN_FCOMM)
      RWN=I00001+SSZ(41)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00135(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(53),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00523')
      RETURN
      END
      SUBROUTINE S00524(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "KENFDEMAND"'
      CurrentIGNO=592
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(41)  ! (all,i,KEN_FCOMM)
      RWN=I00001+SSZ(41)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00135(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(44)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "KENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00524')
      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''',
     *    'PFEEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(19),ECHO1,
     *  ROWBF(41),COLBF(19),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00474(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PFTEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00475(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00476(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00477(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00478(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(26),KZC,DOEQ,STRHS,STRHNZ,
     *  C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00479(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00120,C00122,C00123,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00480(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),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''',
     *    'NCOALFPRICE',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,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00125,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00125,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(46),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00303,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(46),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00303,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00485(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00125,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'NCOALFDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00486(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00126,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00488(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),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 S00489(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(88),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 S00490(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(89),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 S00491(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'NELYFPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00492(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00128,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00493(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),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(88),ECHO1,
     *  ROWBF(48),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00304,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(48),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00304,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00496(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'NELYFDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00497(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00498(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00499(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00500(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00501(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00502(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00129,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ENYFPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00503(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00131,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00504(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  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(88),ECHO1,
     *  ROWBF(50),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00305,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(50),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00305,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00507(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ENYFDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00508(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00509(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00510(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00511(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00512(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00513(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00132,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'KENFPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00514(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(88),ECHO1,
     *  ROWBF(52),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00306,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(52),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00306,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00518(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00134,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'KENFDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00519(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00135,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00520(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00521(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),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 S00522(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(88),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 S00523(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(89),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 S00524(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),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
      RETURN
15000 CALL PERET('M00015')
      RETURN
      END
      SUBROUTINE S00525(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00137,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(44),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "VAENFPRICE"'
      CurrentIGNO=607
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "VAENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(49)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 4 I00008=1,SSZ(44)  ! (all,k,VAEN_FCOMM)
      ENTRY=-C00137(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(48)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(54),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "VAENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00525')
      RETURN
      END
      SUBROUTINE S00526(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(44),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "VAENFPRICE"'
      CurrentIGNO=607
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "VAENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(44)  ! (all,k,VAEN_FCOMM)
      ENTRY=C00137(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(48)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(54),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "VAENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00526')
      RETURN
      END
      SUBROUTINE S00529(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(44),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "VAENFPRICE"'
      CurrentIGNO=607
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "VAENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(44)  ! (all,k,VAEN_FCOMM)
      ENTRY=C00137(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(48)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(54),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "VAENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00138,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "VAENFDEMAND"'
      CurrentIGNO=610
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(44)  ! (all,i,VAEN_FCOMM)
      RWN=I00001+SSZ(44)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00138(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(48)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00138(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(49)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(55),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "VAENFDEMAND"'
      CurrentIGNO=610
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(44)  ! (all,i,VAEN_FCOMM)
      RWN=I00001+SSZ(44)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(48)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(49)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(55),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00531')
      RETURN
      END
      SUBROUTINE S00532(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "VAENFDEMAND"'
      CurrentIGNO=610
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(44)  ! (all,i,VAEN_FCOMM)
      RWN=I00001+SSZ(44)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00138(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(48)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(55),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00532')
      RETURN
      END
      SUBROUTINE S00533(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afsec"'
      CurrentAction2=
     *  ' in equation "VAENFDEMAND"'
      CurrentIGNO=610
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       88)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(44)  ! (all,i,VAEN_FCOMM)
      RWN=I00001+SSZ(44)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00138(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(55),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00533')
      RETURN
      END
      SUBROUTINE S00534(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afreg"'
      CurrentAction2=
     *  ' in equation "VAENFDEMAND"'
      CurrentIGNO=610
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       89)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(44)  ! (all,i,VAEN_FCOMM)
      RWN=I00001+SSZ(44)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00138(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(55),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "VAENFDEMAND"'
      CurrentIGNO=610
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(44)  ! (all,i,VAEN_FCOMM)
      RWN=I00001+SSZ(44)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00138(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(48)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(55),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "VAENFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00140,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00140(SSZ(46),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "EBLFPRICE"'
      CurrentIGNO=622
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "EBLFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(51)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 4 I00008=1,SSZ(46)  ! (all,k,EBL_COMM)
      ENTRY=-C00140(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(50)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(56),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "EBLFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00140,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00140(SSZ(46),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "EBLFPRICE"'
      CurrentIGNO=622
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "EBLFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(46)  ! (all,k,EBL_COMM)
      ENTRY=C00140(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(50)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(56),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "EBLFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00537')
      RETURN
      END
      SUBROUTINE S00540(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00140,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00140(SSZ(46),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "EBLFPRICE"'
      CurrentIGNO=622
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "EBLFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(46)  ! (all,k,EBL_COMM)
      ENTRY=C00140(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(50)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(56),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "EBLFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00141,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00141(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "EBLDEMAND"'
      CurrentIGNO=625
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(46)  ! (all,i,EBL_COMM)
      RWN=I00001+SSZ(46)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00141(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(50)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00141(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(51)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(57),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "EBLDEMAND"'
      CurrentIGNO=625
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(46)  ! (all,i,EBL_COMM)
      RWN=I00001+SSZ(46)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(50)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(51)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(57),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00542')
      RETURN
      END
      SUBROUTINE S00543(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00141,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00141(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "EBLDEMAND"'
      CurrentIGNO=625
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(46)  ! (all,i,EBL_COMM)
      RWN=I00001+SSZ(46)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00141(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(50)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(57),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00543')
      RETURN
      END
      SUBROUTINE S00544(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00141,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00141(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afsec"'
      CurrentAction2=
     *  ' in equation "EBLDEMAND"'
      CurrentIGNO=625
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       88)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(46)  ! (all,i,EBL_COMM)
      RWN=I00001+SSZ(46)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00141(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(57),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00141,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00141(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afreg"'
      CurrentAction2=
     *  ' in equation "EBLDEMAND"'
      CurrentIGNO=625
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       89)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(46)  ! (all,i,EBL_COMM)
      RWN=I00001+SSZ(46)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00141(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(57),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00545')
      RETURN
      END
      SUBROUTINE S00546(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00141,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00141(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "EBLDEMAND"'
      CurrentIGNO=625
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(46)  ! (all,i,EBL_COMM)
      RWN=I00001+SSZ(46)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00141(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(50)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(57),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "EBLDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00143,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00143(SSZ(48),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "EPPFPRICE"'
      CurrentIGNO=637
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "EPPFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(53)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 4 I00008=1,SSZ(48)  ! (all,k,EPP_COMM)
      ENTRY=-C00143(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(52)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(58),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "EPPFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00143,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00143(SSZ(48),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "EPPFPRICE"'
      CurrentIGNO=637
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "EPPFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(48)  ! (all,k,EPP_COMM)
      ENTRY=C00143(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(52)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(58),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "EPPFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00548')
      RETURN
      END
      SUBROUTINE S00551(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00143,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00143(SSZ(48),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "EPPFPRICE"'
      CurrentIGNO=637
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "EPPFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(48)  ! (all,k,EPP_COMM)
      ENTRY=C00143(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(52)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(58),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "EPPFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00551')
      RETURN
      END
      SUBROUTINE S00552(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00144,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00144(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "EPPDEMAND"'
      CurrentIGNO=640
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(48)  ! (all,i,EPP_COMM)
      RWN=I00001+SSZ(48)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00144(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(52)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00144(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(53)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(59),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00552')
      RETURN
      END
      SUBROUTINE S00553(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "EPPDEMAND"'
      CurrentIGNO=640
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(48)  ! (all,i,EPP_COMM)
      RWN=I00001+SSZ(48)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(52)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(53)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(59),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00553')
      RETURN
      END
      SUBROUTINE S00554(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00144,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00144(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "EPPDEMAND"'
      CurrentIGNO=640
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(48)  ! (all,i,EPP_COMM)
      RWN=I00001+SSZ(48)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00144(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(52)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(59),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00554')
      RETURN
      END
      SUBROUTINE S00555(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00144,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00144(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afsec"'
      CurrentAction2=
     *  ' in equation "EPPDEMAND"'
      CurrentIGNO=640
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       88)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(48)  ! (all,i,EPP_COMM)
      RWN=I00001+SSZ(48)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00144(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(59),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00555')
      RETURN
      END
      SUBROUTINE S00556(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00144,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00144(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afreg"'
      CurrentAction2=
     *  ' in equation "EPPDEMAND"'
      CurrentIGNO=640
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       89)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(48)  ! (all,i,EPP_COMM)
      RWN=I00001+SSZ(48)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00144(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(59),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00556')
      RETURN
      END
      SUBROUTINE S00557(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00144,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00144(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "EPPDEMAND"'
      CurrentIGNO=640
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(48)  ! (all,i,EPP_COMM)
      RWN=I00001+SSZ(48)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00144(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(52)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(59),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "EPPDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00557')
      RETURN
      END
      SUBROUTINE S00558(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00146,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00146(SSZ(50),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "EGENFPRICE"'
      CurrentIGNO=652
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "EGENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(55)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 4 I00008=1,SSZ(50)  ! (all,k,EGEN_COMM)
      ENTRY=-C00146(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(54)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(60),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "EGENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00146(SSZ(50),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "EGENFPRICE"'
      CurrentIGNO=652
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "EGENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(50)  ! (all,k,EGEN_COMM)
      ENTRY=C00146(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(54)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(60),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "EGENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00146(SSZ(50),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "EGENFPRICE"'
      CurrentIGNO=652
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "EGENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(50)  ! (all,k,EGEN_COMM)
      ENTRY=C00146(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(54)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(60),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "EGENFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00147,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "EGENDEMAND"'
      CurrentIGNO=655
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(50)  ! (all,i,EGEN_COMM)
      RWN=I00001+SSZ(50)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00147(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(54)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00147(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(55)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "EGENDEMAND"'
      CurrentIGNO=655
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(50)  ! (all,i,EGEN_COMM)
      RWN=I00001+SSZ(50)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(54)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(55)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00564')
      RETURN
      END
      SUBROUTINE S00565(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "EGENDEMAND"'
      CurrentIGNO=655
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(50)  ! (all,i,EGEN_COMM)
      RWN=I00001+SSZ(50)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00147(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(54)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00565')
      RETURN
      END
      SUBROUTINE S00566(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afsec"'
      CurrentAction2=
     *  ' in equation "EGENDEMAND"'
      CurrentIGNO=655
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       88)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(50)  ! (all,i,EGEN_COMM)
      RWN=I00001+SSZ(50)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00147(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00566')
      RETURN
      END
      SUBROUTINE S00567(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afreg"'
      CurrentAction2=
     *  ' in equation "EGENDEMAND"'
      CurrentIGNO=655
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       89)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(50)  ! (all,i,EGEN_COMM)
      RWN=I00001+SSZ(50)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00147(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00567')
      RETURN
      END
      SUBROUTINE S00568(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "EGENDEMAND"'
      CurrentIGNO=655
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(50)  ! (all,i,EGEN_COMM)
      RWN=I00001+SSZ(50)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00147(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(54)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(61),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "EGENDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00568')
      RETURN
      END
      SUBROUTINE S00569(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00149,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00149(SSZ(52),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "ELYFPRICE"'
      CurrentIGNO=669
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "ELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(57)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 4 I00008=1,SSZ(52)  ! (all,k,ELYO_COMM)
      ENTRY=-C00149(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(56)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(62),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "ELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00569')
      RETURN
      END
      SUBROUTINE S00570(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00149,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00149(SSZ(52),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "ELYFPRICE"'
      CurrentIGNO=669
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "ELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(52)  ! (all,k,ELYO_COMM)
      ENTRY=C00149(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(56)-1+I00008)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(62),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "ELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00570')
      RETURN
      END
      SUBROUTINE S00573(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00149,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00149(SSZ(52),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "ELYFPRICE"'
      CurrentIGNO=669
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "ELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00008=1,SSZ(52)  ! (all,k,ELYO_COMM)
      ENTRY=C00149(I00008,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(56)-1+I00008)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(62),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "ELYFPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00573')
      RETURN
      END
      SUBROUTINE S00574(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00150(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "ELYFDEMAND"'
      CurrentIGNO=670
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(52)  ! (all,i,ELYO_COMM)
      RWN=I00001+SSZ(52)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00150(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(56)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-C00150(I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(57)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(82),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(63),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00574')
      RETURN
      END
      SUBROUTINE S00575(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "ELYFDEMAND"'
      CurrentIGNO=670
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(52)  ! (all,i,ELYO_COMM)
      RWN=I00001+SSZ(52)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(56)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(57)-1+1)+SSZ(35)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(63),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00575')
      RETURN
      END
      SUBROUTINE S00576(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00150(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "ELYFDEMAND"'
      CurrentIGNO=670
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(52)  ! (all,i,ELYO_COMM)
      RWN=I00001+SSZ(52)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00150(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(56)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(63),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00576')
      RETURN
      END
      SUBROUTINE S00577(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00150(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afsec"'
      CurrentAction2=
     *  ' in equation "ELYFDEMAND"'
      CurrentIGNO=670
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       88)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(52)  ! (all,i,ELYO_COMM)
      RWN=I00001+SSZ(52)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00150(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(63),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00577')
      RETURN
      END
      SUBROUTINE S00578(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00150(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afreg"'
      CurrentAction2=
     *  ' in equation "ELYFDEMAND"'
      CurrentIGNO=670
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       89)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(52)  ! (all,i,ELYO_COMM)
      RWN=I00001+SSZ(52)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00150(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(63),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00578')
      RETURN
      END
      SUBROUTINE S00579(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00150(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "ELYFDEMAND"'
      CurrentIGNO=670
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(52)  ! (all,i,ELYO_COMM)
      RWN=I00001+SSZ(52)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00150(I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(56)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(63),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "ELYFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00579')
      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''',
     *    'VAENFPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00525(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00137,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00526(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(88),ECHO1,
     *  ROWBF(54),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00307,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(54),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00307,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00529(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'VAENFDEMAND',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,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00138,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00532(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00533(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(88),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00534(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(89),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00535(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EBLFPRICE',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,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00140,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00140,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(56),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00308,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(56),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),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 S00540(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00140,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'EBLDEMAND',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,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00141,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00543(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00141,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00544(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00141,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00141,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00546(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00141,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'EPPFPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00547(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00143,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00143,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(58),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00309,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(58),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00309,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00551(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00143,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'EPPDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00552(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00144,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00553(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00554(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00144,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00555(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00144,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00556(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00144,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00557(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00144,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'EGENFPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00558(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00146,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00559(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(88),ECHO1,
     *  ROWBF(60),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00310,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(60),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00310,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00562(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00146,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EGENDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00563(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00147,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00565(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00566(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(88),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00567(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(89),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00568(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ELYFPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00569(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00149,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00570(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00149,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(62),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00311,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(62),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00311,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00573(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00149,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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''',
     *    'ELYFDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00574(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00575(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00576(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00577(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00578(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00579(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00150,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00580(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ps"'
      CurrentAction2=
     *  ' in equation "ZEROPROFITS"'
      CurrentIGNO=692
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "ZEROPROFITS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00004)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(65),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "ZEROPROFITS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00580')
      RETURN
      END
      SUBROUTINE S00581(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00154,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00154(SSZ(56),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "ZEROPROFITS"'
      CurrentIGNO=692
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "ZEROPROFITS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      ENTRY=-C00154(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(60)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(65),COLBF(82),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "ZEROPROFITS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00581')
      RETURN
      END
      SUBROUTINE S00582(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00154,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00154(SSZ(56),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "ZEROPROFITS"'
      CurrentIGNO=692
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "ZEROPROFITS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      ENTRY=C00154(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(60)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(65),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "ZEROPROFITS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00582')
      RETURN
      END
      SUBROUTINE S00585(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00154,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00154(SSZ(56),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "ZEROPROFITS"'
      CurrentIGNO=692
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "ZEROPROFITS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      RWN=I00004+SSZ(7)*(I00002-1)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      ENTRY=C00154(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(60)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(65),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "ZEROPROFITS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00585')
      RETURN
      END
      SUBROUTINE S00590(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ps"'
      CurrentAction2=
     *  ' in equation "OUTFDEMAND"'
      CurrentIGNO=693
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      RWN=I00001+SSZ(56)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-C00151(I00004)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00004)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "OUTFDEMAND"'
      CurrentIGNO=693
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      RWN=I00001+SSZ(56)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00004)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pf"'
      CurrentAction2=
     *  ' in equation "OUTFDEMAND"'
      CurrentIGNO=693
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pf"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pf',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       82)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      RWN=I00001+SSZ(56)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00151(I00004)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(60)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (I00002-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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pf"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "OUTFDEMAND"'
      CurrentIGNO=693
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      RWN=I00001+SSZ(56)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(60)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00593')
      RETURN
      END
      SUBROUTINE S00594(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afcom"'
      CurrentAction2=
     *  ' in equation "OUTFDEMAND"'
      CurrentIGNO=693
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afcom"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       87)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      RWN=I00001+SSZ(56)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00151(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(60)-1+I00001)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(87),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),COLBF(87),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afcom"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00594')
      RETURN
      END
      SUBROUTINE S00595(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afsec"'
      CurrentAction2=
     *  ' in equation "OUTFDEMAND"'
      CurrentIGNO=693
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afsec"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       88)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      RWN=I00001+SSZ(56)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00151(I00004))
      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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afsec"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afreg"'
      CurrentAction2=
     *  ' in equation "OUTFDEMAND"'
      CurrentIGNO=693
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afreg"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       89)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      RWN=I00001+SSZ(56)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00151(I00004))
      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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afreg"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "OUTFDEMAND"'
      CurrentIGNO=693
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      RWN=I00001+SSZ(56)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00151(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(60)-1+I00001)+SSZ(35)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "aosec"'
      CurrentAction2=
     *  ' in equation "OUTFDEMAND"'
      CurrentIGNO=693
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aosec"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       92)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      RWN=I00001+SSZ(56)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00151(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "aosec"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "aoreg"'
      CurrentAction2=
     *  ' in equation "OUTFDEMAND"'
      CurrentIGNO=693
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aoreg"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       93)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      RWN=I00001+SSZ(56)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00151(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(93),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),COLBF(93),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "aoreg"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00599')
      RETURN
      END
      SUBROUTINE S00600(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(7))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "aoall"'
      CurrentAction2=
     *  ' in equation "OUTFDEMAND"'
      CurrentIGNO=693
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aoall"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       94)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(56)  ! (all,i,OUT_COMM)
      RWN=I00001+SSZ(56)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-(-1.0+C00151(I00004))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00004+SSZ(7)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(94),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(66),COLBF(94),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "aoall"',
     *  ' in equation "OUTFDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00600')
      RETURN
      END
      SUBROUTINE S00601(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "OUTPUTPRICES"'
      CurrentIGNO=694
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "OUTPUTPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      RWN=I00001+SSZ(7)*(I00002-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(67),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "OUTPUTPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00601')
      RETURN
      END
      SUBROUTINE S00602(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ps"'
      CurrentAction2=
     *  ' in equation "OUTPUTPRICES"'
      CurrentIGNO=694
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "OUTPUTPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      RWN=I00001+SSZ(7)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(67),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "OUTPUTPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00602')
      RETURN
      END
      SUBROUTINE S00603(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "to"'
      CurrentAction2=
     *  ' in equation "OUTPUTPRICES"'
      CurrentIGNO=694
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "OUTPUTPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       54)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      RWN=I00001+SSZ(7)*(I00002-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(54),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(67),COLBF(54),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "OUTPUTPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00603')
      RETURN
      END
      SUBROUTINE S00604(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "TOUTRATIO"'
      CurrentIGNO=695
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TOUTRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      ENTRY=-C00070(SSMP(SSMPST(9)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(68),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TOUTRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00604')
      RETURN
      END
      SUBROUTINE S00605(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "TOUTRATIO"'
      CurrentIGNO=695
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "TOUTRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      ENTRY=-C00070(SSMP(SSMPST(9)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(68),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "TOUTRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00605')
      RETURN
      END
      SUBROUTINE S00607(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "to"'
      CurrentAction2=
     *  ' in equation "TOUTRATIO"'
      CurrentIGNO=695
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "TOUTRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       54)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      ENTRY=C00045(SSMP(SSMPST(9)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+I00001)+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(54),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(68),COLBF(54),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "TOUTRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00607')
      RETURN
      END
      SUBROUTINE S00608(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "del_taxrout"'
      CurrentAction2=
     *  ' in equation "TOUTRATIO"'
      CurrentIGNO=695
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrout',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       64)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(64),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(68),COLBF(64),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "del_taxrout"',
     *  ' in equation "TOUTRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00608')
      RETURN
      END
      SUBROUTINE S00609(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00007
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "KAPSVCES"'
      CurrentIGNO=702
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "KAPSVCES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00007=1,SSZ(12)  ! (all,h,ENDWC_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(12)  ! SUM(k,ENDWC_COMM
      RS1=RS1+C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00008))),I00002)
    3 CONTINUE  ! END SUM(k,ENDWC_COMM
      RS2=-C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007))),I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
         ErrorIndName(2)='h           '
         ErrorIndVal(2)=I00007
         ErrorIndSetNo(2)=12
        END IF
      END IF
      ENTRY=RS4
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(69),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "KAPSVCES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00609')
      RETURN
      END
      SUBROUTINE S00611(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00007
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ps"'
      CurrentAction2=
     *  ' in equation "KAPRENTAL"'
      CurrentIGNO=703
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "KAPRENTAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00007=1,SSZ(12)  ! (all,h,ENDWC_COMM)
      RS1=0.0
      DO 3 I00008=1,SSZ(12)  ! SUM(k,ENDWC_COMM
      RS1=RS1+C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-
     *  1+I00008))),I00002)
    3 CONTINUE  ! END SUM(k,ENDWC_COMM
      RS2=-C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007))),I00002)
      RS3=RS1
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
         ErrorIndName(2)='h           '
         ErrorIndVal(2)=I00007
         ErrorIndSetNo(2)=12
        END IF
      END IF
      ENTRY=RS4
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00007)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(70),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "KAPRENTAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00611')
      RETURN
      END
      SUBROUTINE S00613(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00077,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00077(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "CAPGOODS"'
      CurrentIGNO=704
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CAPGOODS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00007=1,SSZ(5)  ! (all,h,CGDS_COMM)
      RS1=-C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)
      RS2=C00077(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
         ErrorIndName(2)='h           '
         ErrorIndVal(2)=I00007
         ErrorIndSetNo(2)=5
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(71),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CAPGOODS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00613')
      RETURN
      END
      SUBROUTINE S00615(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00077,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00077(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ps"'
      CurrentAction2=
     *  ' in equation "PRCGOODS"'
      CurrentIGNO=705
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "PRCGOODS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00007=1,SSZ(5)  ! (all,h,CGDS_COMM)
      RS1=-C00045(SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007)),I00002)
      RS2=C00077(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
         ErrorIndName(2)='h           '
         ErrorIndVal(2)=I00007
         ErrorIndSetNo(2)=5
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(4)-1+I00007))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(72),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "PRCGOODS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00615')
      RETURN
      END
      SUBROUTINE S00619(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "kb"'
      CurrentAction2=
     *  ' in equation "KEND"'
      CurrentIGNO=712
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "KEND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-(1.0-C00156(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(74),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "KEND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00619')
      RETURN
      END
      SUBROUTINE S00629(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "BALDWIN"'
      CurrentIGNO=720
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "BALDWIN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(12)  ! (all,i,ENDWC_COMM)
      RWN=I00001+SSZ(12)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(12)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(77),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "BALDWIN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00629')
      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 S00580(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00581(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00154,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00582(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00154,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(65),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00312,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(89),ECHO1,
     *  ROWBF(65),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00312,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00585(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00154,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(65),COLBF(92),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(93),ECHO1,
     *  ROWBF(65),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(94),ECHO1,
     *  ROWBF(65),COLBF(94),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(95),ECHO1,
     *  ROWBF(65),COLBF(95),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'OUTFDEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00590(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00591(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00592(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(82),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00593(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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 S00594(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(87),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00595(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(88),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00596(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(89),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00597(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00598(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(92),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00599(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(93),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00600(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(94),KZC,DOEQ,STRHS,STRHNZ,
     *  C00151,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S00601(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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 S00602(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00603(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(54),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOUTRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00604(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00605(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(68),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00071,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00607(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(54),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00608(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(64),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'KAPSVCES',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00609(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(101),ECHO1,
     *  ROWBF(69),COLBF(101),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00611(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(96),ECHO1,
     *  ROWBF(70),COLBF(96),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CAPGOODS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00613(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00077,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(100),ECHO1,
     *  ROWBF(71),COLBF(100),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRCGOODS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00615(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00077,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(29),ECHO1,
     *  ROWBF(72),COLBF(29),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'KBEGINNING',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(28),ECHO1,
     *  ROWBF(73),COLBF(28),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(101),ECHO1,
     *  ROWBF(73),COLBF(101),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00619(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00156,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(97),ECHO1,
     *  ROWBF(74),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(100),ECHO1,
     *  ROWBF(74),COLBF(100),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00156,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'RORCURRENT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(29),ECHO1,
     *  ROWBF(75),COLBF(29),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00157,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(75),COLBF(96),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00157,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(75),COLBF(99),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ROREXPECTED',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(28),ECHO1,
     *  ROWBF(76),COLBF(28),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00158,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(97),ECHO1,
     *  ROWBF(76),COLBF(97),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00158,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(98),ECHO1,
     *  ROWBF(76),COLBF(98),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(76),COLBF(99),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'BALDWIN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00629(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(100),ECHO1,
     *  ROWBF(77),COLBF(100),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(102),ECHO1,
     *  ROWBF(77),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
      RETURN
15000 CALL PERET('M00017')
      RETURN
      END
      SUBROUTINE S00632(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00078,C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3
      INTEGER IS1,IS2,IS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00078(SSZ(1))
      INTEGER C00159(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "kb"'
      CurrentAction2=
     *  ' in equation "RORGLOBAL"'
      CurrentIGNO=725
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "RORGLOBAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      IS1=1
      IS2=C00159(1)
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS3=IS1-IS2
      ELSE
        IS3=GPINTOP('-',IS1,IS2)
      END IF
      RS1=-IS3*C00031(I00002)
      RS2=C00078(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(78),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "RORGLOBAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00632')
      RETURN
      END
      SUBROUTINE S00633(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER IS1,IS2,IS3,IS4,IS5,IS6
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00159(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "globalcgds"'
      CurrentAction2=
     *  ' in equation "RORGLOBAL"'
      CurrentIGNO=725
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "globalcgds"',
     *  ' in equation "RORGLOBAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'globalcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       56)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      IS4=1
      IS5=C00159(1)
      IF(ABS(IS4).LE.1000000000.AND.
     *  ABS(IS5).LE.1000000000) THEN
        IS6=IS4-IS5
      ELSE
        IS6=GPINTOP('-',IS4,IS5)
      END IF
      ENTRY=-IS6
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(56),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(78),COLBF(56),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "globalcgds"',
     *  ' in equation "RORGLOBAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00633')
      RETURN
      END
      SUBROUTINE S00634(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER IS1,IS2,IS3,IS4,IS5,IS6
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00159(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "rore"'
      CurrentAction2=
     *  ' in equation "RORGLOBAL"'
      CurrentIGNO=725
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rore"',
     *  ' in equation "RORGLOBAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       98)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00159(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(98),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(78),COLBF(98),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "rore"',
     *  ' in equation "RORGLOBAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00634')
      RETURN
      END
      SUBROUTINE S00635(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00077,C00078,C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3
      INTEGER IS1,IS2,IS3,IS4,IS5,IS6,IS7,IS8,IS9
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00077(SSZ(1))
      REAL C00078(SSZ(1))
      INTEGER C00159(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qcgds"'
      CurrentAction2=
     *  ' in equation "RORGLOBAL"'
      CurrentIGNO=725
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qcgds"',
     *  ' in equation "RORGLOBAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      100)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      IS7=1
      IS8=C00159(1)
      IF(ABS(IS7).LE.1000000000.AND.
     *  ABS(IS8).LE.1000000000) THEN
        IS9=IS7-IS8
      ELSE
        IS9=GPINTOP('-',IS7,IS8)
      END IF
      RS1=IS9*C00077(I00002)
      RS2=C00078(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=2
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(78),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qcgds"',
     *  ' in equation "RORGLOBAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER IS1,IS2,IS3,IS4,IS5,IS6,IS7,IS8,IS9
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00159(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "rorg"'
      CurrentAction2=
     *  ' in equation "RORGLOBAL"'
      CurrentIGNO=725
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rorg"',
     *  ' in equation "RORGLOBAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      103)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-C00159(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(103),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(78),COLBF(103),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "rorg"',
     *  ' in equation "RORGLOBAL"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00636')
      RETURN
      END
      SUBROUTINE S00638(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00079,C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00079(1)
      INTEGER C00159(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "kb"'
      CurrentAction2=
     *  ' in equation "GLOBALINV"'
      CurrentIGNO=726
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "GLOBALINV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=C00159(1)*C00031(I00002)
      RS2=C00079(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "GLOBALINV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00159(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "globalcgds"'
      CurrentAction2=
     *  ' in equation "GLOBALINV"'
      CurrentIGNO=726
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "globalcgds"',
     *  ' in equation "GLOBALINV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'globalcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       56)
      RWN=RWN+1
      ENTRY=C00159(1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(56),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(56),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "globalcgds"',
     *  ' in equation "GLOBALINV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00079,C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3
      INTEGER IS1,IS2,IS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00079(1)
      INTEGER C00159(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "rore"'
      CurrentAction2=
     *  ' in equation "GLOBALINV"'
      CurrentIGNO=726
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rore"',
     *  ' in equation "GLOBALINV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       98)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      IS1=1
      IS2=C00159(1)
      IF(ABS(IS1).LE.1000000000.AND.
     *  ABS(IS2).LE.1000000000) THEN
        IS3=IS1-IS2
      ELSE
        IS3=GPINTOP('-',IS1,IS2)
      END IF
      RS1=-IS3*C00078(I00002)
      RS2=C00079(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=2
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(98),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(98),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "rore"',
     *  ' in equation "GLOBALINV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00640')
      RETURN
      END
      SUBROUTINE S00641(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00077,C00079,C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3
      INTEGER IS1,IS2,IS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00077(SSZ(1))
      REAL C00079(1)
      INTEGER C00159(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qcgds"'
      CurrentAction2=
     *  ' in equation "GLOBALINV"'
      CurrentIGNO=726
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qcgds"',
     *  ' in equation "GLOBALINV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      100)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=-C00159(1)*C00077(I00002)
      RS2=C00079(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=3
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qcgds"',
     *  ' in equation "GLOBALINV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00641')
      RETURN
      END
      SUBROUTINE S00642(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      INTEGER IS1,IS2,IS3,IS4,IS5,IS6
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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 C00159(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "rorg"'
      CurrentAction2=
     *  ' in equation "GLOBALINV"'
      CurrentIGNO=726
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "rorg"',
     *  ' in equation "GLOBALINV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      103)
      RWN=RWN+1
      IS4=1
      IS5=C00159(1)
      IF(ABS(IS4).LE.1000000000.AND.
     *  ABS(IS5).LE.1000000000) THEN
        IS6=IS4-IS5
      ELSE
        IS6=GPINTOP('-',IS4,IS5)
      END IF
      ENTRY=IS6
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(103),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(79),COLBF(103),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "rorg"',
     *  ' in equation "GLOBALINV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00642')
      RETURN
      END
      SUBROUTINE S00643(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00079,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00079(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pcgds"'
      CurrentAction2=
     *  ' in equation "PRICGDS"'
      CurrentIGNO=727
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "PRICGDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       29)
      RWN=RWN+1
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=-C00078(I00002)
      RS2=C00079(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    1 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(80),COLBF(29),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "PRICGDS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00643')
      RETURN
      END
      SUBROUTINE S00646(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00078,C00079,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00078(SSZ(1))
      REAL C00079(1)
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pcgds"'
      CurrentAction2=
     *  ' in equation "SAVEPRICE"'
      CurrentIGNO=729
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "SAVEPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       29)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      RS1=-(C00078(I00003)-C00009(I00003))
      RS2=C00079(1)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
         ErrorIndName(2)='s           '
         ErrorIndVal(2)=I00003
         ErrorIndSetNo(2)=1
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00003
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(81),COLBF(29),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "SAVEPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00646')
      RETURN
      END
      SUBROUTINE S00648(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00323,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00323(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "TEXPRATIO"'
      CurrentIGNO=733
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TEXPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00323(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TEXPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00648')
      RETURN
      END
      SUBROUTINE S00651(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "del_taxrexp"'
      CurrentAction2=
     *  ' in equation "TEXPRATIO"'
      CurrentIGNO=733
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrexp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       65)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(65),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(83),COLBF(65),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "del_taxrexp"',
     *  ' in equation "TEXPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00651')
      RETURN
      END
      SUBROUTINE S00653(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00035,C00072,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "TEXPRATIO"'
      CurrentIGNO=733
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "TEXPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-(-C00035(I00001,I00002,I00003)-
     *  C00072(I00001,I00002,I00003))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(83),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "TEXPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00653')
      RETURN
      END
      SUBROUTINE S00654(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00160,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00160(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "DPRICEIMP"'
      CurrentIGNO=739
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "DPRICEIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00008=1,SSZ(1)  ! (all,k,REG)
      ENTRY=-C00160(I00001,I00008,I00003)*C00173(I00001,I00008,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00008-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(85),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "DPRICEIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00654')
      RETURN
      END
      SUBROUTINE S00657(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00160,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00160(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "DPRICEIMP"'
      CurrentIGNO=739
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "DPRICEIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00008=1,SSZ(1)  ! (all,k,REG)
      ENTRY=C00160(I00001,I00008,I00003)*C00173(I00001,I00008,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00008-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(85),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "DPRICEIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00657')
      RETURN
      END
      SUBROUTINE S00658(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00160,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00160(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "DPRICEIMP"'
      CurrentIGNO=739
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "DPRICEIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00008=1,SSZ(1)  ! (all,k,REG)
      ENTRY=C00160(I00001,I00008,I00003)*C00173(I00001,I00008,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00008-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(85),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "DPRICEIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00658')
      RETURN
      END
      SUBROUTINE S00661(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00356,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00356(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "DPRICEIMP"'
      CurrentIGNO=739
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "DPRICEIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=C00356(I00005,I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(85),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "DPRICEIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00661')
      RETURN
      END
      SUBROUTINE S00663(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00160,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00160(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ats"'
      CurrentAction2=
     *  ' in equation "DPRICEIMP"'
      CurrentIGNO=739
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ats"',
     *  ' in equation "DPRICEIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      115)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00008=1,SSZ(1)  ! (all,k,REG)
      ENTRY=C00160(I00001,I00008,I00003)*C00347(I00001,I00008,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00008
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(115),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(85),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ats"',
     *  ' in equation "DPRICEIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00663')
      RETURN
      END
      SUBROUTINE S00666(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PRICETGT"'
      CurrentIGNO=741
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PRICETGT"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(86),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PRICETGT"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00666')
      RETURN
      END
      SUBROUTINE S00669(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00161(SSZ(2))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "IMPORTDEMAND"'
      CurrentIGNO=744
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
      ENTRY=C00161(I00001)*C00173(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00669')
      RETURN
      END
      SUBROUTINE S00673(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00161(SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ams"'
      CurrentAction2=
     *  ' in equation "IMPORTDEMAND"'
      CurrentIGNO=744
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       85)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
      ENTRY=-(-1.0+C00161(I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(87),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00673')
      RETURN
      END
      SUBROUTINE S00674(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00161(SSZ(2))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "IMPORTDEMAND"'
      CurrentIGNO=744
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
      ENTRY=-C00161(I00001)*C00173(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(87),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00161(SSZ(2))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "IMPORTDEMAND"'
      CurrentIGNO=744
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
      ENTRY=-C00161(I00001)*C00173(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(87),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00675')
      RETURN
      END
      SUBROUTINE S00678(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00171,C00174,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00161(SSZ(2))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "IMPORTDEMAND"'
      CurrentIGNO=744
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
      DO 4 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=-C00161(I00001)*C00174(I00001,I00002,I00003)*
     *  C00171(I00005,I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(87),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00161(SSZ(2))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atf"'
      CurrentAction2=
     *  ' in equation "IMPORTDEMAND"'
      CurrentIGNO=744
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atf"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      114)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
      ENTRY=-C00161(I00001)*C00347(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(114),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(87),COLBF(114),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atf"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00161(SSZ(2))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ats"'
      CurrentAction2=
     *  ' in equation "IMPORTDEMAND"'
      CurrentIGNO=744
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ats"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      115)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
      ENTRY=-C00161(I00001)*C00347(I00001,I00002,I00003)
      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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(87),COLBF(115),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ats"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00680')
      RETURN
      END
      SUBROUTINE S00681(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00161(SSZ(2))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atd"'
      CurrentAction2=
     *  ' in equation "IMPORTDEMAND"'
      CurrentIGNO=744
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atd"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      116)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
      ENTRY=-C00161(I00001)*C00347(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00003
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(116),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(87),COLBF(116),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atd"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00681')
      RETURN
      END
      SUBROUTINE S00682(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00171,C00174,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00161(SSZ(2))
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pt"'
      CurrentAction2=
     *  ' in equation "IMPORTDEMAND"'
      CurrentIGNO=744
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pt"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      120)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
      DO 4 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=C00161(I00001)*C00174(I00001,I00002,I00003)*
     *  C00171(I00005,I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(120),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(87),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pt"',
     *  ' in equation "IMPORTDEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00682')
      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''',
     *    'RORGLOBAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00632(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00078,C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00633(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(56),KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00634(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(98),KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00635(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(100),KZC,DOEQ,STRHS,STRHNZ,
     *  C00077,C00078,C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00636(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(103),KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(104),ECHO1,
     *  ROWBF(78),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''',
     *    'GLOBALINV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00638(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00079,C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00639(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(56),KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00640(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(98),KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00079,C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00641(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(100),KZC,DOEQ,STRHS,STRHNZ,
     *  C00077,C00079,C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00642(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(103),KZC,DOEQ,STRHS,STRHNZ,
     *  C00159,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S00643(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(29),KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00079,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(57),ECHO1,
     *  ROWBF(80),COLBF(57),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'SAVEPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(1),ECHO1,
     *  ROWBF(81),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 S00646(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(29),KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00078,C00079,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(105),ECHO1,
     *  ROWBF(81),COLBF(105),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TEXPRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00648(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00323,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(83),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00072,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(83),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00073,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00651(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(65),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(106),ECHO1,
     *  ROWBF(83),COLBF(106),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00324,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00653(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00035,C00072,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S00654(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00160,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(85),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(85),ECHO1,
     *  ROWBF(85),COLBF(85),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00657(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00160,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00658(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00160,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(108),ECHO1,
     *  ROWBF(85),COLBF(108),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00342,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(109),ECHO1,
     *  ROWBF(85),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00661(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00356,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(114),ECHO1,
     *  ROWBF(85),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00357,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00663(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(115),KZC,DOEQ,STRHS,STRHNZ,
     *  C00160,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(85),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00357,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(120),ECHO1,
     *  ROWBF(85),COLBF(120),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),SSZ(1),1,1,1,1,C00358,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S00666(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(86),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(110),ECHO1,
     *  ROWBF(86),COLBF(110),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00669(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(87),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),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(31),ECHO1,
     *  ROWBF(87),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(55),ECHO1,
     *  ROWBF(87),COLBF(55),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00673(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00674(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(108),ECHO1,
     *  ROWBF(87),COLBF(108),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),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(109),ECHO1,
     *  ROWBF(87),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00678(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00171,C00174,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(114),KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(115),KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00681(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(116),KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00682(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(120),KZC,DOEQ,STRHS,STRHNZ,
     *  C00161,C00171,C00174,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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('M00018')
      RETURN
      END
      SUBROUTINE S00683(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "TIMPRATIO"'
      CurrentIGNO=745
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TIMPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00074(I00001,I00003,I00002)*C00173(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(88),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TIMPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00683')
      RETURN
      END
      SUBROUTINE S00686(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "del_taxrimp"'
      CurrentAction2=
     *  ' in equation "TIMPRATIO"'
      CurrentIGNO=745
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrimp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       66)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(66),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(88),COLBF(66),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "del_taxrimp"',
     *  ' in equation "TIMPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00686')
      RETURN
      END
      SUBROUTINE S00687(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "TIMPRATIO"'
      CurrentIGNO=745
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "TIMPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00074(I00001,I00003,I00002)*C00173(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(88),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "TIMPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00687')
      RETURN
      END
      SUBROUTINE S00688(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "TIMPRATIO"'
      CurrentIGNO=745
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "TIMPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00074(I00001,I00003,I00002)*C00173(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(88),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "TIMPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00688')
      RETURN
      END
      SUBROUTINE S00691(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00360,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00360(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "TIMPRATIO"'
      CurrentIGNO=745
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "TIMPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=C00360(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(88),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "TIMPRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00691')
      RETURN
      END
      SUBROUTINE S00697(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00343(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "TRANS_DEMAND"'
      CurrentIGNO=773
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005
      ENTRY=C00343(I00005)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(90),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "TRANS_DEMAND"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00697')
      RETURN
      END
      SUBROUTINE S00702(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00169,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00169(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PTRANSPORT"'
      CurrentIGNO=777
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PTRANSPORT"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=-C00169(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(91),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PTRANSPORT"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00702')
      RETURN
      END
      SUBROUTINE S00704(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "TRANSVCES"'
      CurrentIGNO=785
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TRANSVCES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TRANSVCES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00704')
      RETURN
      END
      SUBROUTINE S00711(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00082,C00175,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00082(SSZ(1))
      REAL C00175(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "EMTRADING"'
      CurrentIGNO=799
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "EMTRADING"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-(C00175(I00002)-C00082(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(97),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "EMTRADING"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00711')
      RETURN
      END
      SUBROUTINE S00712(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00082,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00082(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2t"'
      CurrentAction2=
     *  ' in equation "EMTRADING"'
      CurrentIGNO=799
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2t"',
     *  ' in equation "EMTRADING"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2t',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       58)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00082(I00002)*C00043(I00002)*0.01
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(58),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(97),COLBF(58),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2t"',
     *  ' in equation "EMTRADING"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00712')
      RETURN
      END
      SUBROUTINE S00714(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00175(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2q"'
      CurrentAction2=
     *  ' in equation "EMTRADING"'
      CurrentIGNO=799
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2q"',
     *  ' in equation "EMTRADING"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2q',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      121)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-C00175(I00002)*C00043(I00002)*0.01
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(121),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(97),COLBF(121),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2q"',
     *  ' in equation "EMTRADING"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00714')
      RETURN
      END
      SUBROUTINE S00715(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00082,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      REAL RS1
      LOGICAL LG1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00082(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2t"'
      CurrentAction2=
     *  ' in equation "TOTALEMISSIONSB"'
      CurrentIGNO=802
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2t"',
     *  ' in equation "TOTALEMISSIONSB"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2t',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       58)
      DO 1 I00006=1,SSZ(17)  ! (all,b,BLOC)
      RWN=I00006
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG:)
      RS1=0.0
      LG1=C00008(I00002).EQ.I00006
      IF(LG1) THEN
      RS1=-C00082(I00002)
      END IF
      ENTRY=RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(58),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(98),COLBF(58),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2t"',
     *  ' in equation "TOTALEMISSIONSB"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00715')
      RETURN
      END
      SUBROUTINE S00717(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      REAL RS1
      LOGICAL LG1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00175(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2q"'
      CurrentAction2=
     *  ' in equation "EMISSQUOTA"'
      CurrentIGNO=805
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2q"',
     *  ' in equation "EMISSQUOTA"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2q',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      121)
      DO 1 I00006=1,SSZ(17)  ! (all,b,BLOC)
      RWN=I00006
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG:)
      RS1=0.0
      LG1=C00008(I00002).EQ.I00006
      IF(LG1) THEN
      RS1=-C00175(I00002)
      END IF
      ENTRY=RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(121),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(99),COLBF(121),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2q"',
     *  ' in equation "EMISSQUOTA"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00717')
      RETURN
      END
      SUBROUTINE S00722(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "FACTORINCPRICES"'
      CurrentIGNO=819
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RWN=I00001+SSZ(6)*(I00002-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(101),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00722')
      RETURN
      END
      SUBROUTINE S00723(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ps"'
      CurrentAction2=
     *  ' in equation "FACTORINCPRICES"'
      CurrentIGNO=819
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ps"',
     *  ' in equation "FACTORINCPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ps',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       17)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RWN=I00001+SSZ(6)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(17),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(101),COLBF(17),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ps"',
     *  ' in equation "FACTORINCPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00723')
      RETURN
      END
      SUBROUTINE S00724(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "to"'
      CurrentAction2=
     *  ' in equation "FACTORINCPRICES"'
      CurrentIGNO=819
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "FACTORINCPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       54)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RWN=I00001+SSZ(6)*(I00002-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(54),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(101),COLBF(54),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "FACTORINCPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00724')
      RETURN
      END
      SUBROUTINE S00725(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "TINCRATIO"'
      CurrentIGNO=822
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TINCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      ENTRY=-C00070(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(102),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TINCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00725')
      RETURN
      END
      SUBROUTINE S00726(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "TINCRATIO"'
      CurrentIGNO=822
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "TINCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      ENTRY=-C00070(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(102),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "TINCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00726')
      RETURN
      END
      SUBROUTINE S00728(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "to"'
      CurrentAction2=
     *  ' in equation "TINCRATIO"'
      CurrentIGNO=822
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "to"',
     *  ' in equation "TINCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'to',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       54)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      ENTRY=C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(54),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(102),COLBF(54),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "to"',
     *  ' in equation "TINCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00728')
      RETURN
      END
      SUBROUTINE S00729(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "del_taxrinc"'
      CurrentAction2=
     *  ' in equation "TINCRATIO"'
      CurrentIGNO=822
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_taxrinc',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       67)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(67),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(102),COLBF(67),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "del_taxrinc"',
     *  ' in equation "TINCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00729')
      RETURN
      END
      SUBROUTINE S00730(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "ENDW_PRICE"'
      CurrentIGNO=825
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(10)  ! (all,i,ENDWS_COMM)
      RWN=I00001+SSZ(10)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(103),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "ENDW_PRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00730')
      RETURN
      END
      SUBROUTINE S00731(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00181,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00181(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pmes"'
      CurrentAction2=
     *  ' in equation "ENDW_PRICE"'
      CurrentIGNO=825
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmes',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(10)  ! (all,i,ENDWS_COMM)
      RWN=I00001+SSZ(10)*(I00002-1)
      DO 3 I00008=1,SSZ(7)  ! (all,k,PROD_COMM)
      ENTRY=-C00181(SSMP(SSMPST(10)-1+I00001),I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(10)*(I00008-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(103),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pmes"',
     *  ' in equation "ENDW_PRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00731')
      RETURN
      END
      SUBROUTINE S00732(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00182,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00182(SSZ(6))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "ENDW_SUPPLY"'
      CurrentIGNO=828
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(10)  ! (all,i,ENDWS_COMM)
      RWN=I00001+SSZ(10)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-C00182(SSMP(SSMPST(10)-1+I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(104),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "ENDW_SUPPLY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00732')
      RETURN
      END
      SUBROUTINE S00733(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "ENDW_SUPPLY"'
      CurrentIGNO=828
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(10)  ! (all,i,ENDWS_COMM)
      RWN=I00001+SSZ(10)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(104),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "ENDW_SUPPLY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00733')
      RETURN
      END
      SUBROUTINE S00734(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00182,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00182(SSZ(6))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pmes"'
      CurrentAction2=
     *  ' in equation "ENDW_SUPPLY"'
      CurrentIGNO=828
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pmes',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       27)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(10)  ! (all,i,ENDWS_COMM)
      RWN=I00001+SSZ(10)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00182(SSMP(SSMPST(10)-1+I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(10)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(27),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(104),COLBF(27),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pmes"',
     *  ' in equation "ENDW_SUPPLY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00734')
      RETURN
      END
      SUBROUTINE S00736(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "endwslack"'
      CurrentAction2=
     *  ' in equation "ENDW_SUPPLY"'
      CurrentIGNO=828
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'endwslack',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       46)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(10)  ! (all,i,ENDWS_COMM)
      RWN=I00001+SSZ(10)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(10)-1+I00001)+SSZ(6)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(46),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(104),COLBF(46),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "endwslack"',
     *  ' in equation "ENDW_SUPPLY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00736')
      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''',
     *    'TIMPRATIO',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,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(88),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00074,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(88),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00075,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00686(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(66),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00687(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00688(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00074,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(108),ECHO1,
     *  ROWBF(88),COLBF(108),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),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(109),ECHO1,
     *  ROWBF(88),COLBF(109),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00032,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00691(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00360,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(88),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(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(115),ECHO1,
     *  ROWBF(88),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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(116),ECHO1,
     *  ROWBF(88),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00363,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(120),ECHO1,
     *  ROWBF(88),COLBF(120),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TRANS_DEMAND',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(31),ECHO1,
     *  ROWBF(90),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),SSZ(1),SSZ(1),1,1,1,C00168,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00697(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00343,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(114),ECHO1,
     *  ROWBF(90),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),1,1,1,1,1,C00344,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(90),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00345,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(116),ECHO1,
     *  ROWBF(90),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),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(119),ECHO1,
     *  ROWBF(90),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''',
     *    'PTRANSPORT',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00702(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00169,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(120),ECHO1,
     *  ROWBF(91),COLBF(120),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TRANSVCES',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00704(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(94),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(119),ECHO1,
     *  ROWBF(94),COLBF(119),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(120),ECHO1,
     *  ROWBF(94),COLBF(120),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PEMPURCH',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(58),ECHO1,
     *  ROWBF(96),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(121),ECHO1,
     *  ROWBF(96),COLBF(121),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(122),ECHO1,
     *  ROWBF(96),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''',
     *    'EMTRADING',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00711(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00082,C00175,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00712(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(58),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00082,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(59),ECHO1,
     *  ROWBF(97),COLBF(59),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00714(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(121),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOTALEMISSIONSB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00715(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(58),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00082,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(98),COLBF(123),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(17),1,1,1,1,1,1,C00083,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EMISSQUOTA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00717(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(121),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(99),COLBF(124),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(17),1,1,1,1,1,1,C00176,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PEMPURCHB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(123),ECHO1,
     *  ROWBF(100),COLBF(123),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(124),ECHO1,
     *  ROWBF(100),COLBF(124),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(125),ECHO1,
     *  ROWBF(100),COLBF(125),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S00722(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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 S00723(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(17),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00724(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(54),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TINCRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00725(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00726(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(102),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00180,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00728(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(54),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00729(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(67),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'ENDW_PRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00730(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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 S00731(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00181,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S00732(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00182,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00733(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00734(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(27),KZC,DOEQ,STRHS,STRHNZ,
     *  C00182,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(45),ECHO1,
     *  ROWBF(104),COLBF(45),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00736(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(46),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00019')
      RETURN
      END
      SUBROUTINE S00739(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PIEMISSIONS"'
      CurrentIGNO=830
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-C00076(I00001)*(1  -C00104(I00001,I00002))*
     *  C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(106),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00739')
      RETURN
      END
      SUBROUTINE S00740(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "PIEMISSIONS"'
      CurrentIGNO=830
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00076(I00001)*C00102(I00001,I00002)-C00076(I00001)*
     *  C00104(I00001,I00002)*C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(106),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00740')
      RETURN
      END
      SUBROUTINE S00741(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "PIEMISSIONS"'
      CurrentIGNO=830
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-C00076(I00001)*(1  -C00104(I00001,I00002))*
     *  C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(106),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "PIEMISSIONS"'
      CurrentIGNO=830
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00076(I00001)*C00102(I00001,I00002)-C00076(I00001)*
     *  C00104(I00001,I00002)*C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(106),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00742')
      RETURN
      END
      SUBROUTINE S00744(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00101,C00103,C00104,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "PIEMISSIONS"'
      CurrentIGNO=830
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00076(I00001)*100.0 *C00103(I00001,I00002)+C00076(I00001)*
     *  (-C00104(I00001,I00002)*100.0 *C00103(I00001,I00002)-(1  -
     *  C00104(I00001,I00002))*100.0 *C00101(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(106),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "PIEMISSIONS"'
      CurrentIGNO=830
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(27)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(106),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "PIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00745')
      RETURN
      END
      SUBROUTINE S00748(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "GIEMISSIONS"'
      CurrentIGNO=832
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-C00076(I00001)*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(108),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00748')
      RETURN
      END
      SUBROUTINE S00749(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "GIEMISSIONS"'
      CurrentIGNO=832
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-C00076(I00001)*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(108),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00749')
      RETURN
      END
      SUBROUTINE S00750(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "GIEMISSIONS"'
      CurrentIGNO=832
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00076(I00001)*C00088(I00001,I00002)-C00076(I00001)*
     *  C00090(I00001,I00002)*C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(108),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00750')
      RETURN
      END
      SUBROUTINE S00751(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "GIEMISSIONS"'
      CurrentIGNO=832
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00076(I00001)*C00088(I00001,I00002)-C00076(I00001)*
     *  C00090(I00001,I00002)*C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(108),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00751')
      RETURN
      END
      SUBROUTINE S00753(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00087,C00089,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "GIEMISSIONS"'
      CurrentIGNO=832
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00076(I00001)*100.0 *C00089(I00001,I00002)+C00076(I00001)*
     *  (-C00090(I00001,I00002)*100.0 *C00089(I00001,I00002)-(1  -
     *  C00090(I00001,I00002))*100.0 *C00087(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(108),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00753')
      RETURN
      END
      SUBROUTINE S00754(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "GIEMISSIONS"'
      CurrentIGNO=832
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+I00001)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(108),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "GIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00754')
      RETURN
      END
      SUBROUTINE S00757(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "FIEMISSIONS"'
      CurrentIGNO=834
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-C00076(I00001)*(1  -C00123(I00001,I00004,I00002))*
     *  C00119(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(110),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00757')
      RETURN
      END
      SUBROUTINE S00758(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "FIEMISSIONS"'
      CurrentIGNO=834
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00076(I00001)*C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(110),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfd"'
      CurrentAction2=
     *  ' in equation "FIEMISSIONS"'
      CurrentIGNO=834
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       23)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-C00076(I00001)*(1  -C00123(I00001,I00004,I00002))*
     *  C00119(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(110),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfm"'
      CurrentAction2=
     *  ' in equation "FIEMISSIONS"'
      CurrentIGNO=834
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       26)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00076(I00001)*C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(26),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(110),COLBF(26),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00760')
      RETURN
      END
      SUBROUTINE S00762(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00120,C00122,C00123,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "FIEMISSIONS"'
      CurrentIGNO=834
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=C00076(I00001)*100.0 *C00122(I00001,I00004,I00002)+
     *  C00076(I00001)*(-C00123(I00001,I00004,I00002)*100.0 *
     *  C00122(I00001,I00004,I00002)-(1  -C00123(I00001,I00004,I00002))*
     *  100.0 *C00120(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(110),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    4 CONTINUE
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00762')
      RETURN
      END
      SUBROUTINE S00763(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "FIEMISSIONS"'
      CurrentIGNO=834
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(110),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "FIEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00037,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00037(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2fd"'
      CurrentAction2=
     *  ' in equation "CEMISSIONS"'
      CurrentIGNO=835
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2fd"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2fd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       35)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(14)  ! (all,i,CTAX_COMM)
      RWN=I00002+SSZ(1)*(I00001-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00037(SSMP(SSMPST(14)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(14)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(35),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(111),COLBF(35),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2fd"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00764')
      RETURN
      END
      SUBROUTINE S00765(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00038(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2fm"'
      CurrentAction2=
     *  ' in equation "CEMISSIONS"'
      CurrentIGNO=835
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2fm"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2fm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       36)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(14)  ! (all,i,CTAX_COMM)
      RWN=I00002+SSZ(1)*(I00001-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00038(SSMP(SSMPST(14)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(14)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(36),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(111),COLBF(36),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2fm"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00765')
      RETURN
      END
      SUBROUTINE S00766(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00039,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00039(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2gd"'
      CurrentAction2=
     *  ' in equation "CEMISSIONS"'
      CurrentIGNO=835
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2gd"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2gd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       37)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(14)  ! (all,i,CTAX_COMM)
      RWN=I00002+SSZ(1)*(I00001-1)
      ENTRY=-C00039(SSMP(SSMPST(14)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(14)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(37),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(111),COLBF(37),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2gd"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00040,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00040(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2gm"'
      CurrentAction2=
     *  ' in equation "CEMISSIONS"'
      CurrentIGNO=835
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2gm"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2gm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       38)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(14)  ! (all,i,CTAX_COMM)
      RWN=I00002+SSZ(1)*(I00001-1)
      ENTRY=-C00040(SSMP(SSMPST(14)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(14)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(38),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(111),COLBF(38),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2gm"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00767')
      RETURN
      END
      SUBROUTINE S00768(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00041,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00041(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2pd"'
      CurrentAction2=
     *  ' in equation "CEMISSIONS"'
      CurrentIGNO=835
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2pd"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2pd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       39)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(14)  ! (all,i,CTAX_COMM)
      RWN=I00002+SSZ(1)*(I00001-1)
      ENTRY=-C00041(SSMP(SSMPST(14)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(14)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(39),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(111),COLBF(39),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2pd"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00768')
      RETURN
      END
      SUBROUTINE S00769(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00042(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2pm"'
      CurrentAction2=
     *  ' in equation "CEMISSIONS"'
      CurrentIGNO=835
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2pm"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       40)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(14)  ! (all,i,CTAX_COMM)
      RWN=I00002+SSZ(1)*(I00001-1)
      ENTRY=-C00042(SSMP(SSMPST(14)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(14)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(40),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(111),COLBF(40),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2pm"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00769')
      RETURN
      END
      SUBROUTINE S00770(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00081,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(1),SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2"'
      CurrentAction2=
     *  ' in equation "CEMISSIONS"'
      CurrentIGNO=835
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      126)
      DO 1 I00001=1,SSZ(14)  ! (all,i,CTAX_COMM)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002+SSZ(1)*(I00001-1)
      ENTRY=C00081(I00002,SSMP(SSMPST(14)-1+I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002+SSZ(1)*(I00001-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(126),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(111),COLBF(126),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2"',
     *  ' in equation "CEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00770')
      RETURN
      END
      SUBROUTINE S00772(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00081,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(1),SSZ(2))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2"'
      CurrentAction2=
     *  ' in equation "TOTALEMISSIONS"'
      CurrentIGNO=836
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2"',
     *  ' in equation "TOTALEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      126)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(14)  ! (all,i,CTAX_COMM)
      ENTRY=-C00081(I00002,SSMP(SSMPST(14)-1+I00001))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002+SSZ(1)*(I00001-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(126),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(112),COLBF(126),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2"',
     *  ' in equation "TOTALEMISSIONS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00772')
      RETURN
      END
      SUBROUTINE S00774(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00082,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00082(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2tw"'
      CurrentAction2=
     *  ' in equation "WORLDEMISS"'
      CurrentIGNO=838
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2tw"',
     *  ' in equation "WORLDEMISS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2tw',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      131)
      RWN=RWN+1
      RS1=0.0
      DO 1 I00002=1,SSZ(1)  ! SUM(r,REG
      RS1=RS1+C00082(I00002)
    1 CONTINUE  ! END SUM(r,REG
      ENTRY=RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(131),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(113),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2tw"',
     *  ' in equation "WORLDEMISS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00183,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00183(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "REALTAXCH"'
      CurrentIGNO=844
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "REALTAXCH"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=-1.0
      RS2=C00183(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(114),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "REALTAXCH"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00775')
      RETURN
      END
      SUBROUTINE S00776(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00183,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00183(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "p"'
      CurrentAction2=
     *  ' in equation "REALTAXCH"'
      CurrentIGNO=844
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "p"',
     *  ' in equation "REALTAXCH"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'p',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       43)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=1.0
      RS2=C00183(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=2
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3*0.01  *C00043(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(43),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(114),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "p"',
     *  ' in equation "REALTAXCH"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00776')
      RETURN
      END
      SUBROUTINE S00778(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      REAL RS1
      LOGICAL LG1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "p"'
      CurrentAction2=
     *  ' in equation "PIND_b"'
      CurrentIGNO=848
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "p"',
     *  ' in equation "PIND_b"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'p',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       43)
      DO 1 I00006=1,SSZ(17)  ! (all,b,BLOC)
      RWN=I00006
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG:)
      RS1=0.0
      LG1=C00008(I00002).EQ.I00006
      IF(LG1) THEN
      RS1=-C00052(I00002)
      END IF
      ENTRY=RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(43),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(115),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "p"',
     *  ' in equation "PIND_b"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00185,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      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 C00185(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "REALTAXCHB"'
      CurrentIGNO=856
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "REALTAXCHB"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO 1 I00006=1,SSZ(17)  ! (all,b,BLOC)
      RWN=I00006
      RS1=-1.0
      RS2=C00185(I00006)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='b           '
         ErrorIndVal(1)=I00006
         ErrorIndSetNo(1)=17
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00006
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(116),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "REALTAXCHB"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00185,C00186,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      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 C00185(SSZ(17))
      REAL C00186(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pb"'
      CurrentAction2=
     *  ' in equation "REALTAXCHB"'
      CurrentIGNO=856
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pb"',
     *  ' in equation "REALTAXCHB"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      133)
      DO 1 I00006=1,SSZ(17)  ! (all,b,BLOC)
      RWN=I00006
      RS1=1.0
      RS2=C00185(I00006)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=2
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='b           '
         ErrorIndVal(1)=I00006
         ErrorIndSetNo(1)=17
        END IF
      END IF
      ENTRY=RS3*0.01  *C00186(I00006)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00006
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(133),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(116),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pb"',
     *  ' in equation "REALTAXCHB"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00175,C00187,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00175(SSZ(1))
      REAL C00187(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "TCRATIO"'
      CurrentIGNO=861
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-100.0 *C00187(I00002)*C00175(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00783')
      RETURN
      END
      SUBROUTINE S00784(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00175,C00187,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00175(SSZ(1))
      REAL C00187(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "y"'
      CurrentAction2=
     *  ' in equation "TCRATIO"'
      CurrentIGNO=861
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "y"',
     *  ' in equation "TCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'y',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       42)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00187(I00002)*C00043(I00002)*C00175(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(42),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(42),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "y"',
     *  ' in equation "TCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00784')
      RETURN
      END
      SUBROUTINE S00785(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "del_ctaxr"'
      CurrentAction2=
     *  ' in equation "TCRATIO"'
      CurrentIGNO=861
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_ctaxr"',
     *  ' in equation "TCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_ctaxr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       68)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(68),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(68),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "del_ctaxr"',
     *  ' in equation "TCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00785')
      RETURN
      END
      SUBROUTINE S00786(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00175,C00187,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00175(SSZ(1))
      REAL C00187(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2q"'
      CurrentAction2=
     *  ' in equation "TCRATIO"'
      CurrentIGNO=861
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2q"',
     *  ' in equation "TCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2q',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      121)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-C00187(I00002)*C00043(I00002)*C00175(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(121),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(121),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2q"',
     *  ' in equation "TCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00786')
      RETURN
      END
      SUBROUTINE S00787(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00175(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "del_ctgshr"'
      CurrentAction2=
     *  ' in equation "TCRATIO"'
      CurrentIGNO=861
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "del_ctgshr"',
     *  ' in equation "TCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'del_ctgshr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      135)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-100.0 *C00043(I00002)*C00175(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(135),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(117),COLBF(135),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "del_ctgshr"',
     *  ' in equation "TCRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00787')
      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''',
     *    'PDEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(12),ECHO1,
     *  ROWBF(105),COLBF(12),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(39),ECHO1,
     *  ROWBF(105),COLBF(39),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PIEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00739(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00100,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 S00740(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00102,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 S00741(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00100,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 S00742(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00102,C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(40),ECHO1,
     *  ROWBF(106),COLBF(40),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00744(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00101,C00103,C00104,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(74),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''',
     *    'GDEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(4),ECHO1,
     *  ROWBF(107),COLBF(4),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(37),ECHO1,
     *  ROWBF(107),COLBF(37),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GIEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00748(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00749(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00750(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00751(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(38),ECHO1,
     *  ROWBF(108),COLBF(38),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00753(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00087,C00089,C00090,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00754(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),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''',
     *    'FDEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(22),ECHO1,
     *  ROWBF(109),COLBF(22),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(35),ECHO1,
     *  ROWBF(109),COLBF(35),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'FIEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00757(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00758(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00759(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00760(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(26),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(36),ECHO1,
     *  ROWBF(110),COLBF(36),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00762(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00076,C00120,C00122,C00123,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00763(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00764(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(35),KZC,DOEQ,STRHS,STRHNZ,
     *  C00037,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00765(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(36),KZC,DOEQ,STRHS,STRHNZ,
     *  C00038,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00766(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(37),KZC,DOEQ,STRHS,STRHNZ,
     *  C00039,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00767(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(38),KZC,DOEQ,STRHS,STRHNZ,
     *  C00040,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00768(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(39),KZC,DOEQ,STRHS,STRHNZ,
     *  C00041,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00769(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(40),KZC,DOEQ,STRHS,STRHNZ,
     *  C00042,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00770(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(126),KZC,DOEQ,STRHS,STRHNZ,
     *  C00081,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOTALEMISSIONS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(58),ECHO1,
     *  ROWBF(112),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00082,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00772(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(126),KZC,DOEQ,STRHS,STRHNZ,
     *  C00081,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'WORLDEMISS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(58),ECHO1,
     *  ROWBF(113),COLBF(58),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00082,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00774(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(131),KZC,DOEQ,STRHS,STRHNZ,
     *  C00082,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'REALTAXCH',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00775(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00183,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00776(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(43),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00183,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(132),ECHO1,
     *  ROWBF(114),COLBF(132),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PIND_b',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00778(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(43),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(133),ECHO1,
     *  ROWBF(115),COLBF(133),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(17),1,1,1,1,1,1,C00184,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'REALTAXCHB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00780(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00185,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00781(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(133),KZC,DOEQ,STRHS,STRHNZ,
     *  C00185,C00186,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(134),ECHO1,
     *  ROWBF(116),COLBF(134),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TCRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00783(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00175,C00187,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00784(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(42),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00175,C00187,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00785(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(68),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00786(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(121),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00175,C00187,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00787(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(135),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,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 S00788(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "FACTORINCOME"'
      CurrentIGNO=865
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCOME"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      ENTRY=-C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(118),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "FACTORINCOME"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00788')
      RETURN
      END
      SUBROUTINE S00789(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "FACTORINCOME"'
      CurrentIGNO=865
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "FACTORINCOME"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      ENTRY=-C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(118),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "FACTORINCOME"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00789')
      RETURN
      END
      SUBROUTINE S00813(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00175,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00175(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "REGIONALINCOME"'
      CurrentIGNO=875
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "REGIONALINCOME"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-100.0 *C00175(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(122),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "REGIONALINCOME"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00813')
      RETURN
      END
      SUBROUTINE S00814(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00189,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      REAL C00189(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "y"'
      CurrentAction2=
     *  ' in equation "REGIONALINCOME"'
      CurrentIGNO=875
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "y"',
     *  ' in equation "REGIONALINCOME"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'y',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       42)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00052(I00002)-C00189(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(42),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(122),COLBF(42),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "y"',
     *  ' in equation "REGIONALINCOME"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00814')
      RETURN
      END
      SUBROUTINE S00815(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00175(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "gco2q"'
      CurrentAction2=
     *  ' in equation "REGIONALINCOME"'
      CurrentIGNO=875
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "gco2q"',
     *  ' in equation "REGIONALINCOME"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'gco2q',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      121)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-C00175(I00002)*C00043(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(121),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(122),COLBF(121),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "gco2q"',
     *  ' in equation "REGIONALINCOME"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00815')
      RETURN
      END
      SUBROUTINE S00817(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "del_indtaxr"'
      CurrentAction2=
     *  ' in equation "REGIONALINCOME"'
      CurrentIGNO=875
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      137)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-100.0 *C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(137),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(122),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "del_indtaxr"',
     *  ' in equation "REGIONALINCOME"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00817')
      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''',
     *    'FACTORINCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00788(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00789(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(28),ECHO1,
     *  ROWBF(118),COLBF(28),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00031,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(29),ECHO1,
     *  ROWBF(118),COLBF(29),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00031,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(136),ECHO1,
     *  ROWBF(118),COLBF(136),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00188,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DINDTAXRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(60),ECHO1,
     *  ROWBF(119),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(119),COLBF(61),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(62),ECHO1,
     *  ROWBF(119),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(63),ECHO1,
     *  ROWBF(119),COLBF(63),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(64),ECHO1,
     *  ROWBF(119),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(65),ECHO1,
     *  ROWBF(119),COLBF(65),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(66),ECHO1,
     *  ROWBF(119),COLBF(66),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(137),ECHO1,
     *  ROWBF(119),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''',
     *    'DNCTAXRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(60),ECHO1,
     *  ROWBF(120),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(120),COLBF(61),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(62),ECHO1,
     *  ROWBF(120),COLBF(62),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(63),ECHO1,
     *  ROWBF(120),COLBF(63),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(64),ECHO1,
     *  ROWBF(120),COLBF(64),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(65),ECHO1,
     *  ROWBF(120),COLBF(65),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(66),ECHO1,
     *  ROWBF(120),COLBF(66),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(67),ECHO1,
     *  ROWBF(120),COLBF(67),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(138),ECHO1,
     *  ROWBF(120),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''',
     *    '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(68),ECHO1,
     *  ROWBF(121),COLBF(68),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(121),COLBF(138),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(139),ECHO1,
     *  ROWBF(121),COLBF(139),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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''',
     *    'REGIONALINCOME',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00813(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00175,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00814(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(42),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,C00189,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00815(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(121),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00175,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(136),ECHO1,
     *  ROWBF(122),COLBF(136),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00188,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00817(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(137),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(140),ECHO1,
     *  ROWBF(122),COLBF(140),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00052,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DPARAV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(127),ECHO1,
     *  ROWBF(123),COLBF(127),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(128),ECHO1,
     *  ROWBF(123),COLBF(128),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00178,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(129),ECHO1,
     *  ROWBF(123),COLBF(129),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00179,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(123),COLBF(141),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'UTILITELASTIC',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(51),ECHO1,
     *  ROWBF(124),COLBF(51),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(130),ECHO1,
     *  ROWBF(124),COLBF(130),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(141),ECHO1,
     *  ROWBF(124),COLBF(141),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVCONSEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(125),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(51),ECHO1,
     *  ROWBF(125),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(125),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(127),ECHO1,
     *  ROWBF(125),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(130),ECHO1,
     *  ROWBF(125),COLBF(130),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GOVCONSEXP',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(126),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(48),ECHO1,
     *  ROWBF(126),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(128),ECHO1,
     *  ROWBF(126),COLBF(128),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(130),ECHO1,
     *  ROWBF(126),COLBF(130),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'SAVING',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(1),ECHO1,
     *  ROWBF(127),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(127),COLBF(2),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(127),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(129),ECHO1,
     *  ROWBF(127),COLBF(129),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(130),ECHO1,
     *  ROWBF(127),COLBF(130),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00021')
      RETURN
      END
      SUBROUTINE S00843(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,C00084,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      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 C00049(SSZ(1))
      REAL C00084(SSZ(19),SSZ(1))
      REAL C00178(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pg"'
      CurrentAction2=
     *  ' in equation "PRICEINDEXREG"'
      CurrentIGNO=882
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pg"',
     *  ' in equation "PRICEINDEXREG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pg',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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(25)  ! (all,i,UG_COMM)
      RS1=-C00178(I00002)*C00084(SSMP(SSMPST(25)-1+I00001),I00002)
      RS2=C00049(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
         ErrorIndName(2)='i           '
         ErrorIndVal(2)=I00001
         ErrorIndSetNo(2)=25
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(25)-1+I00001)+SSZ(19)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(128),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pg"',
     *  ' in equation "PRICEINDEXREG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00843')
      RETURN
      END
      SUBROUTINE S00844(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00191,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00191(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "y"'
      CurrentAction2=
     *  ' in equation "UTILITY"'
      CurrentIGNO=909
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "y"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'y',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       42)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=-1.0
      RS2=C00191(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(42),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(42),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "y"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00844')
      RETURN
      END
      SUBROUTINE S00845(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00191,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00191(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "p"'
      CurrentAction2=
     *  ' in equation "UTILITY"'
      CurrentIGNO=909
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "p"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'p',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       43)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=1.0
      RS2=C00191(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=2
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(43),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "p"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00845')
      RETURN
      END
      SUBROUTINE S00846(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00191,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00191(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pop"'
      CurrentAction2=
     *  ' in equation "UTILITY"'
      CurrentIGNO=909
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=1.0
      RS2=C00191(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=3
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00846')
      RETURN
      END
      SUBROUTINE S00847(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,C00195,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00192(SSZ(1))
      REAL C00195(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dppriv"'
      CurrentAction2=
     *  ' in equation "UTILITY"'
      CurrentIGNO=909
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      127)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=REAL(C00195(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        ErrorLogeNo=1
        NumActiveInd=1
        ErrorRVal1=RS1
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00192(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(127),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(127),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00847')
      RETURN
      END
      SUBROUTINE S00848(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00193,C00196,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00193(SSZ(1))
      REAL C00196(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dpgov"'
      CurrentAction2=
     *  ' in equation "UTILITY"'
      CurrentIGNO=909
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      128)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=REAL(C00196(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        ErrorLogeNo=2
        NumActiveInd=1
        ErrorRVal1=RS1
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00193(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(128),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(128),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00848')
      RETURN
      END
      SUBROUTINE S00849(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00194,C00197,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00194(SSZ(1))
      REAL C00197(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dpsave"'
      CurrentAction2=
     *  ' in equation "UTILITY"'
      CurrentIGNO=909
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      129)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=REAL(C00197(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        ErrorLogeNo=3
        NumActiveInd=1
        ErrorRVal1=RS1
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00194(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(129),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(129),COLBF(129),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "UTILITY"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00849')
      RETURN
      END
      SUBROUTINE S00860(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "MKTCLTRD_MARG"'
      CurrentIGNO=926
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(132),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLTRD_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00860')
      RETURN
      END
      SUBROUTINE S00861(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00203,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00203(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxs"'
      CurrentAction2=
     *  ' in equation "MKTCLTRD_MARG"'
      CurrentIGNO=926
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00203(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(132),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "MKTCLTRD_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00861')
      RETURN
      END
      SUBROUTINE S00863(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00201,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00201(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qds"'
      CurrentAction2=
     *  ' in equation "MKTCLTRD_MARG"'
      CurrentIGNO=926
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      145)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=-C00201(SSMP(SSMPST(1)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(145),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(132),COLBF(145),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLTRD_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00863')
      RETURN
      END
      SUBROUTINE S00864(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tradslack"'
      CurrentAction2=
     *  ' in equation "MKTCLTRD_MARG"'
      CurrentIGNO=926
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      146)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(146),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(132),COLBF(146),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tradslack"',
     *  ' in equation "MKTCLTRD_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00864')
      RETURN
      END
      SUBROUTINE S00865(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "MKTCLTRD_NMRG"'
      CurrentIGNO=927
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(133),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLTRD_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00865')
      RETURN
      END
      SUBROUTINE S00866(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00203,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00203(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxs"'
      CurrentAction2=
     *  ' in equation "MKTCLTRD_NMRG"'
      CurrentIGNO=927
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00203(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(133),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "MKTCLTRD_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00866')
      RETURN
      END
      SUBROUTINE S00867(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00201,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00201(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qds"'
      CurrentAction2=
     *  ' in equation "MKTCLTRD_NMRG"'
      CurrentIGNO=927
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      145)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=-C00201(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(145),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(133),COLBF(145),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qds"',
     *  ' in equation "MKTCLTRD_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00867')
      RETURN
      END
      SUBROUTINE S00868(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tradslack"'
      CurrentAction2=
     *  ' in equation "MKTCLTRD_NMRG"'
      CurrentIGNO=927
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      146)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(146),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(133),COLBF(146),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tradslack"',
     *  ' in equation "MKTCLTRD_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00868')
      RETURN
      END
      SUBROUTINE S00869(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00282,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00282(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "MKTCLIMP"'
      CurrentIGNO=936
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00282(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00086,C00090,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00207(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "MKTCLIMP"'
      CurrentIGNO=936
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-C00207(I00001,I00002)*C00076(I00001)*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00870')
      RETURN
      END
      SUBROUTINE S00872(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00088,C00090,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00207(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "MKTCLIMP"'
      CurrentIGNO=936
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00207(I00001,I00002)*(C00076(I00001)*C00088(I00001,I00002)-
     *  C00076(I00001)*C00090(I00001,I00002)*C00088(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00872')
      RETURN
      END
      SUBROUTINE S00873(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00100,C00104,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00206(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "MKTCLIMP"'
      CurrentIGNO=936
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-C00206(I00001,I00002)*C00076(I00001)*(1  -
     *  C00104(I00001,I00002))*C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00873')
      RETURN
      END
      SUBROUTINE S00874(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00102,C00104,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00206(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "MKTCLIMP"'
      CurrentIGNO=936
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00206(I00001,I00002)*C00076(I00001)*C00102(I00001,I00002)-
     *  C00206(I00001,I00002)*C00076(I00001)*C00104(I00001,I00002)*
     *  C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00874')
      RETURN
      END
      SUBROUTINE S00875(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00119,C00123,C00205,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00205(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfd"'
      CurrentAction2=
     *  ' in equation "MKTCLIMP"'
      CurrentIGNO=936
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       23)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00205(I00001,I00004,I00002)*C00076(I00001)*(1  -
     *  C00123(I00001,I00004,I00002))*C00119(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00875')
      RETURN
      END
      SUBROUTINE S00876(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00121,C00123,C00205,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00205(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfm"'
      CurrentAction2=
     *  ' in equation "MKTCLIMP"'
      CurrentIGNO=936
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       26)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=C00205(I00001,I00004,I00002)*(C00076(I00001)*
     *  C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(26),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(26),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00876')
      RETURN
      END
      SUBROUTINE S00877(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00284,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00284(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "MKTCLIMP"'
      CurrentIGNO=936
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00284(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00877')
      RETURN
      END
      SUBROUTINE S00879(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00207(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "MKTCLIMP"'
      CurrentIGNO=936
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-C00207(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+I00001)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00879')
      RETURN
      END
      SUBROUTINE S00880(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00206(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "MKTCLIMP"'
      CurrentIGNO=936
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-C00206(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(27)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00880')
      RETURN
      END
      SUBROUTINE S00881(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00205,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00205(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "MKTCLIMP"'
      CurrentIGNO=936
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00205(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(134),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "MKTCLENDWM"'
      CurrentIGNO=939
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLENDWM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(11)  ! (all,i,ENDWM_COMM)
      RWN=I00001+SSZ(11)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(135),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "MKTCLENDWM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "endwslack"'
      CurrentAction2=
     *  ' in equation "MKTCLENDWM"'
      CurrentIGNO=939
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "endwslack"',
     *  ' in equation "MKTCLENDWM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'endwslack',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       46)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(11)  ! (all,i,ENDWM_COMM)
      RWN=I00001+SSZ(11)*(I00002-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(11)-1+I00001)+SSZ(6)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(46),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(135),COLBF(46),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "endwslack"',
     *  ' in equation "MKTCLENDWM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00208,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00208(SSZ(11),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "MKTCLENDWM"'
      CurrentIGNO=939
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLENDWM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(11)  ! (all,i,ENDWM_COMM)
      RWN=I00001+SSZ(11)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00208(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001)))+SSZ(35)*(I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(135),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLENDWM"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00884')
      RETURN
      END
      SUBROUTINE S00886(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "MKTCLENDWS"'
      CurrentIGNO=940
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLENDWS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(10)  ! (all,i,ENDWS_COMM)
      RWN=I00001+SSZ(10)*(I00004-1+SSZ(7)*(I00002-1))
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(10)-1+
     *  I00001)))+SSZ(35)*(I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(136),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "MKTCLENDWS"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00886')
      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''',
     *    'PRICEINDEXREG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(1),ECHO1,
     *  ROWBF(128),COLBF(1),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00179,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(43),ECHO1,
     *  ROWBF(128),COLBF(43),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(50),ECHO1,
     *  ROWBF(128),COLBF(50),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00843(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(69),KZC,DOEQ,STRHS,STRHNZ,
     *  C00049,C00084,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''',
     *    'UTILITY',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00844(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(42),KZC,DOEQ,STRHS,STRHNZ,
     *  C00191,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00845(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(43),KZC,DOEQ,STRHS,STRHNZ,
     *  C00191,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00846(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00191,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00847(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(127),KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,C00195,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00848(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(128),KZC,DOEQ,STRHS,STRHNZ,
     *  C00193,C00196,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00849(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(129),KZC,DOEQ,STRHS,STRHNZ,
     *  C00194,C00197,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(129),COLBF(142),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(129),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''',
     *    'DISTPARSUM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(127),ECHO1,
     *  ROWBF(130),COLBF(127),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00192,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(128),ECHO1,
     *  ROWBF(130),COLBF(128),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00193,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(129),ECHO1,
     *  ROWBF(130),COLBF(129),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00194,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(130),COLBF(143),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00190,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    '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(131),COLBF(4),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00200,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(12),ECHO1,
     *  ROWBF(131),COLBF(12),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00199,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(22),ECHO1,
     *  ROWBF(131),COLBF(22),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(7),SSZ(1),1,1,1,1,C00198,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(145),ECHO1,
     *  ROWBF(131),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''',
     *    'MKTCLTRD_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00860(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00861(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00203,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(132),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00202,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00863(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(145),KZC,DOEQ,STRHS,STRHNZ,
     *  C00201,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00864(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(146),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 S00865(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00866(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00203,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00867(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(145),KZC,DOEQ,STRHS,STRHNZ,
     *  C00201,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00868(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(146),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 S00869(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00282,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00870(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00086,C00090,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(134),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00283,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00872(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00088,C00090,C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00873(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00100,C00104,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00874(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00102,C00104,C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00875(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00119,C00123,C00205,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00876(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(26),KZC,DOEQ,STRHS,STRHNZ,
     *  C00076,C00121,C00123,C00205,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00877(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00284,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(55),ECHO1,
     *  ROWBF(134),COLBF(55),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00879(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00207,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00880(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),KZC,DOEQ,STRHS,STRHNZ,
     *  C00206,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00881(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00205,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLENDWM',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00882(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00883(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(46),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00884(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00208,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'MKTCLENDWS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(45),ECHO1,
     *  ROWBF(136),COLBF(45),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00886(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'WALRAS_S',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(56),ECHO1,
     *  ROWBF(137),COLBF(56),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(57),ECHO1,
     *  ROWBF(137),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(147),ECHO1,
     *  ROWBF(137),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
      RETURN
15000 CALL PERET('M00022')
      RETURN
      END
      SUBROUTINE S00896(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "REALRETURN"'
      CurrentIGNO=961
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "REALRETURN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RWN=I00001+SSZ(6)*(I00003-1)
      ENTRY=-1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "REALRETURN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00896')
      RETURN
      END
      SUBROUTINE S00899(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00047(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PRIMFACTPR"'
      CurrentIGNO=965
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PRIMFACTPR"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      ENTRY=-C00047(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PRIMFACTPR"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00899')
      RETURN
      END
      SUBROUTINE S00903(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00036,C00325,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00325(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "REGSUPRICE"'
      CurrentIGNO=971
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "REGSUPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00325(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      DO 4 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=-C00036(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(143),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "REGSUPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00903')
      RETURN
      END
      SUBROUTINE S00907(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "REGDEMPRICE"'
      CurrentIGNO=973
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "REGDEMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00008=1,SSZ(1)  ! (all,k,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00033(I00001,I00008,I00002)*C00173(I00001,I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00008-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(144),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "REGDEMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00907')
      RETURN
      END
      SUBROUTINE S00908(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "REGDEMPRICE"'
      CurrentIGNO=973
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "REGDEMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00008=1,SSZ(1)  ! (all,k,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00033(I00001,I00008,I00002)*C00173(I00001,I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00008-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(144),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "REGDEMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00908')
      RETURN
      END
      SUBROUTINE S00909(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00008
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "REGDEMPRICE"'
      CurrentIGNO=973
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "REGDEMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00008=1,SSZ(1)  ! (all,k,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00033(I00001,I00008,I00002)*C00173(I00001,I00008,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00008-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(144),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "REGDEMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00909')
      RETURN
      END
      SUBROUTINE S00910(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00365,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00365(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "REGDEMPRICE"'
      CurrentIGNO=973
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "REGDEMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=C00365(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(144),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "REGDEMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00910')
      RETURN
      END
      SUBROUTINE S00919(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00036,C00173,C00327,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      REAL C00327(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00327(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      DO 4 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=-C00036(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00033(I00001,I00003,I00002)*C00173(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
    6 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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00048(I00001,I00002)*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00920')
      RETURN
      END
      SUBROUTINE S00921(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00050,C00088,C00090,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00048(I00001,I00002)*C00090(I00001,I00002)*
     *  C00088(I00001,I00002)-C00050(I00001,I00002)*
     *  C00104(I00001,I00002)*C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00921')
      RETURN
      END
      SUBROUTINE S00922(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00048(I00001,I00002)*C00090(I00001,I00002)*
     *  C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00050(I00001,I00002)*(1  -C00104(I00001,I00002))*
     *  C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00050(I00001,I00002)*C00104(I00001,I00002)*
     *  C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00924')
      RETURN
      END
      SUBROUTINE S00926(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxs"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00034(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00033(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00926')
      RETURN
      END
      SUBROUTINE S00928(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00269,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00269(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00269(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00048(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+I00001)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00929')
      RETURN
      END
      SUBROUTINE S00930(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00050(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(27)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00930')
      RETURN
      END
      SUBROUTINE S00932(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,C00328,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      REAL C00328(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00033(I00001,I00003,I00002)*C00173(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
    4 CONTINUE
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00328(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00932')
      RETURN
      END
      SUBROUTINE S00933(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,C00173,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00033(I00001,I00003,I00002)*C00173(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00034(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00933')
      RETURN
      END
      SUBROUTINE S00934(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00370,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00370(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "VGDP_r"'
      CurrentIGNO=979
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=C00370(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(146),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "VGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00934')
      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''',
     *    '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(138),COLBF(1),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00009,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(2),ECHO1,
     *  ROWBF(138),COLBF(2),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00009,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(148),ECHO1,
     *  ROWBF(138),COLBF(148),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00079,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'WALRAS',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(147),ECHO1,
     *  ROWBF(139),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(148),ECHO1,
     *  ROWBF(139),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(149),ECHO1,
     *  ROWBF(139),COLBF(149),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'REALRETURN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00896(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(50),ECHO1,
     *  ROWBF(140),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(154),ECHO1,
     *  ROWBF(140),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''',
     *    'PRIMFACTPR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00899(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00047,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(155),ECHO1,
     *  ROWBF(141),COLBF(155),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00213,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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(155),ECHO1,
     *  ROWBF(142),COLBF(155),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00213,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(156),ECHO1,
     *  ROWBF(142),COLBF(156),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00214,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S00903(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00036,C00325,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(143),COLBF(106),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00326,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(143),COLBF(107),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00034,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(157),ECHO1,
     *  ROWBF(143),COLBF(157),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00210,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00907(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00908(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00909(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00910(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00365,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(144),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(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(115),ECHO1,
     *  ROWBF(144),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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(116),ECHO1,
     *  ROWBF(144),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00368,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(120),ECHO1,
     *  ROWBF(144),COLBF(120),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),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(158),ECHO1,
     *  ROWBF(144),COLBF(158),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00212,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(157),ECHO1,
     *  ROWBF(145),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(145),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(159),ECHO1,
     *  ROWBF(145),COLBF(159),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00919(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00036,C00173,C00327,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00921(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00050,C00088,C00090,C00102,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 S00922(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00923(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00100,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 S00924(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00102,C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(29),ECHO1,
     *  ROWBF(146),COLBF(29),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00926(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(146),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00036,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00928(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00269,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(70),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00930(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),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(100),ECHO1,
     *  ROWBF(146),COLBF(100),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00932(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,C00328,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00933(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,C00173,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00934(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00370,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(146),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(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(115),ECHO1,
     *  ROWBF(146),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),SSZ(1),1,1,1,1,1,C00372,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(116),ECHO1,
     *  ROWBF(146),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00373,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(120),ECHO1,
     *  ROWBF(146),COLBF(120),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00374,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(146),COLBF(160),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00215,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00023')
      RETURN
      END
      SUBROUTINE S00940(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00036,C00173,C00327,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      REAL C00327(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PGDP_r"'
      CurrentIGNO=981
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00327(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      DO 4 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=-C00036(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00033(I00001,I00003,I00002)*C00173(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(147),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00940')
      RETURN
      END
      SUBROUTINE S00941(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "PGDP_r"'
      CurrentIGNO=981
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00048(I00001,I00002)*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(147),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00941')
      RETURN
      END
      SUBROUTINE S00942(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00050,C00088,C00090,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "PGDP_r"'
      CurrentIGNO=981
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00048(I00001,I00002)*C00090(I00001,I00002)*
     *  C00088(I00001,I00002)-C00050(I00001,I00002)*
     *  C00104(I00001,I00002)*C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(147),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00942')
      RETURN
      END
      SUBROUTINE S00943(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "PGDP_r"'
      CurrentIGNO=981
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00048(I00001,I00002)*C00090(I00001,I00002)*
     *  C00088(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(147),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00943')
      RETURN
      END
      SUBROUTINE S00944(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "PGDP_r"'
      CurrentIGNO=981
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00050(I00001,I00002)*(1  -C00104(I00001,I00002))*
     *  C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(147),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00944')
      RETURN
      END
      SUBROUTINE S00945(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "PGDP_r"'
      CurrentIGNO=981
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00050(I00001,I00002)*C00104(I00001,I00002)*
     *  C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(147),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00945')
      RETURN
      END
      SUBROUTINE S00947(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00269,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00269(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "PGDP_r"'
      CurrentIGNO=981
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00269(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(147),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00947')
      RETURN
      END
      SUBROUTINE S00948(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,C00328,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      REAL C00328(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "PGDP_r"'
      CurrentIGNO=981
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00033(I00001,I00003,I00002)*C00173(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
    4 CONTINUE
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00328(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(147),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00948')
      RETURN
      END
      SUBROUTINE S00949(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,C00173,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "PGDP_r"'
      CurrentIGNO=981
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00033(I00001,I00003,I00002)*C00173(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00034(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(147),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00949')
      RETURN
      END
      SUBROUTINE S00950(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00370,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00370(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "PGDP_r"'
      CurrentIGNO=981
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=C00370(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(147),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "PGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00950')
      RETURN
      END
      SUBROUTINE S00956(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxs"'
      CurrentAction2=
     *  ' in equation "QGDP_r"'
      CurrentIGNO=983
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00034(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00033(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(148),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "QGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00956')
      RETURN
      END
      SUBROUTINE S00958(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "QGDP_r"'
      CurrentIGNO=983
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "QGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00048(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+I00001)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(148),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "QGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00958')
      RETURN
      END
      SUBROUTINE S00959(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "QGDP_r"'
      CurrentIGNO=983
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "QGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-C00050(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(27)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(148),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "QGDP_r"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00959')
      RETURN
      END
      SUBROUTINE S00962(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00329,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00329(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "VREGEX_ir_MARG"'
      CurrentIGNO=1002
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=C00329(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VREGEX_ir_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00962')
      RETURN
      END
      SUBROUTINE S00963(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxs"'
      CurrentAction2=
     *  ' in equation "VREGEX_ir_MARG"'
      CurrentIGNO=1002
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(150),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "VREGEX_ir_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00963')
      RETURN
      END
      SUBROUTINE S00965(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00330,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00330(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "VREGEX_ir_MARG"'
      CurrentIGNO=1002
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=C00330(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(150),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "VREGEX_ir_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00965')
      RETURN
      END
      SUBROUTINE S00966(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "VREGEX_ir_MARG"'
      CurrentIGNO=1002
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(150),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "VREGEX_ir_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00966')
      RETURN
      END
      SUBROUTINE S00967(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00209(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "vxwfob"'
      CurrentAction2=
     *  ' in equation "VREGEX_ir_MARG"'
      CurrentIGNO=1002
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      150)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=C00209(SSMP(SSMPST(1)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(150),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(150),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "vxwfob"',
     *  ' in equation "VREGEX_ir_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00967')
      RETURN
      END
      SUBROUTINE S00968(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00331,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00331(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "VREGEX_ir_NMRG"'
      CurrentIGNO=1003
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=C00331(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(151),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VREGEX_ir_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00968')
      RETURN
      END
      SUBROUTINE S00969(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxs"'
      CurrentAction2=
     *  ' in equation "VREGEX_ir_NMRG"'
      CurrentIGNO=1003
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(151),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "VREGEX_ir_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00969')
      RETURN
      END
      SUBROUTINE S00970(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00332,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00332(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "VREGEX_ir_NMRG"'
      CurrentIGNO=1003
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=C00332(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(151),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "VREGEX_ir_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00970')
      RETURN
      END
      SUBROUTINE S00971(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "VREGEX_ir_NMRG"'
      CurrentIGNO=1003
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(151),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "VREGEX_ir_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00971')
      RETURN
      END
      SUBROUTINE S00972(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00209(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "vxwfob"'
      CurrentAction2=
     *  ' in equation "VREGEX_ir_NMRG"'
      CurrentIGNO=1003
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      150)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=C00209(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(150),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(151),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "vxwfob"',
     *  ' in equation "VREGEX_ir_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00972')
      RETURN
      END
      SUBROUTINE S00979(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "VREGIM_is"'
      CurrentIGNO=1009
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=-C00033(I00001,I00002,I00003)*C00173(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(155),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VREGIM_is"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00979')
      RETURN
      END
      SUBROUTINE S00981(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "VREGIM_is"'
      CurrentIGNO=1009
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=C00033(I00001,I00002,I00003)*C00173(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(155),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "VREGIM_is"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00981')
      RETURN
      END
      SUBROUTINE S00982(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "VREGIM_is"'
      CurrentIGNO=1009
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=C00033(I00001,I00002,I00003)*C00173(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(155),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "VREGIM_is"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00982')
      RETURN
      END
      SUBROUTINE S00983(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00375,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00375(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "VREGIM_is"'
      CurrentIGNO=1009
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=C00375(I00005,I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(155),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "VREGIM_is"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00983')
      RETURN
      END
      SUBROUTINE S00985(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ats"'
      CurrentAction2=
     *  ' in equation "VREGIM_is"'
      CurrentIGNO=1009
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      115)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=C00033(I00001,I00002,I00003)*C00347(I00001,I00002,I00003)
      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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(155),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ats"',
     *  ' in equation "VREGIM_is"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00985')
      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''',
     *    'PGDP_r',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00940(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00036,C00173,C00327,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00941(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00942(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00050,C00088,C00090,C00102,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 S00943(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00944(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00100,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 S00945(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00102,C00104,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(29),ECHO1,
     *  ROWBF(147),COLBF(29),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00947(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00269,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00948(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,C00328,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00949(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,C00173,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00950(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00370,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(147),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(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(115),ECHO1,
     *  ROWBF(147),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),SSZ(1),1,1,1,1,1,C00372,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(116),ECHO1,
     *  ROWBF(147),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00373,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(120),ECHO1,
     *  ROWBF(147),COLBF(120),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00374,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(147),COLBF(161),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00215,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S00956(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00034,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(148),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00036,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00958(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00959(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),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(100),ECHO1,
     *  ROWBF(148),COLBF(100),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00077,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(162),ECHO1,
     *  ROWBF(148),COLBF(162),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00215,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S00962(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00329,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00963(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(150),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00036,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00965(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00330,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00966(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00967(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(150),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
      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 S00968(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00331,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00969(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00970(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00332,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00971(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00972(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(150),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
      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(150),ECHO1,
     *  ROWBF(152),COLBF(150),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00209,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(152),ECHO1,
     *  ROWBF(152),COLBF(152),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00210,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(150),ECHO1,
     *  ROWBF(153),COLBF(150),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00209,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(165),ECHO1,
     *  ROWBF(153),COLBF(165),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,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''',
     *    '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(152),ECHO1,
     *  ROWBF(154),COLBF(152),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00210,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(154),COLBF(166),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00217,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S00979(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(155),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00033,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00981(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00982(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S00983(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00375,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(155),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00376,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00985(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(115),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(155),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00376,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(120),ECHO1,
     *  ROWBF(155),COLBF(120),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),SSZ(1),1,1,1,1,C00377,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(151),ECHO1,
     *  ROWBF(155),COLBF(151),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00211,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(151),ECHO1,
     *  ROWBF(156),COLBF(151),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00211,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(156),COLBF(153),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00212,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00993(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "VWLDOUT"'
      CurrentIGNO=1014
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "VWLDOUT"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=-C00220(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(158),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "VWLDOUT"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00993')
      RETURN
      END
      SUBROUTINE S00996(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00276,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00276(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "VWLDOUTUSE"'
      CurrentIGNO=1016
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=C00276(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(159),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "VWLDOUTUSE"'
      CurrentIGNO=1016
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00048(I00001,I00003)*(1  -C00090(I00001,I00003))*
     *  C00086(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(159),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S00997')
      RETURN
      END
      SUBROUTINE S00999(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "VWLDOUTUSE"'
      CurrentIGNO=1016
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00048(I00001,I00003)*C00090(I00001,I00003)*
     *  C00088(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(159),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "VWLDOUTUSE"'
      CurrentIGNO=1016
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00050(I00001,I00003)*(1  -C00104(I00001,I00003))*
     *  C00100(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(159),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "VWLDOUTUSE"'
      CurrentIGNO=1016
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00050(I00001,I00003)*C00104(I00001,I00003)*
     *  C00102(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(159),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfd"'
      CurrentAction2=
     *  ' in equation "VWLDOUTUSE"'
      CurrentIGNO=1016
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       23)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)*(1  -
     *  C00123(I00001,I00004,I00003))*C00119(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(159),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01002')
      RETURN
      END
      SUBROUTINE S01003(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfm"'
      CurrentAction2=
     *  ' in equation "VWLDOUTUSE"'
      CurrentIGNO=1016
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       26)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)*
     *  C00123(I00001,I00004,I00003)*C00121(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(26),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(159),COLBF(26),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01003')
      RETURN
      END
      SUBROUTINE S01004(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00278,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00278(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "VWLDOUTUSE"'
      CurrentIGNO=1016
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=C00278(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(159),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "VWLDOUTUSE"'
      CurrentIGNO=1016
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00048(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+I00001)+SSZ(19)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(159),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "VWLDOUTUSE"'
      CurrentIGNO=1016
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       74)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00050(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(27)*(I00003-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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(159),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "VWLDOUTUSE"'
      CurrentIGNO=1016
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(I00003-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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(159),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "VWLDOUTUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01007')
      RETURN
      END
      SUBROUTINE S01009(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00329,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00329(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PREGEX_ir_MARG"'
      CurrentIGNO=1017
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=C00329(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PREGEX_ir_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01009')
      RETURN
      END
      SUBROUTINE S01010(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00330,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00330(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "PREGEX_ir_MARG"'
      CurrentIGNO=1017
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=C00330(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(160),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "PREGEX_ir_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01010')
      RETURN
      END
      SUBROUTINE S01011(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "PREGEX_ir_MARG"'
      CurrentIGNO=1017
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(160),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "PREGEX_ir_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01011')
      RETURN
      END
      SUBROUTINE S01012(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00209(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pxw"'
      CurrentAction2=
     *  ' in equation "PREGEX_ir_MARG"'
      CurrentIGNO=1017
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      164)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=C00209(SSMP(SSMPST(1)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(164),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(160),COLBF(164),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pxw"',
     *  ' in equation "PREGEX_ir_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01012')
      RETURN
      END
      SUBROUTINE S01013(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00331,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00331(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PREGEX_ir_NMRG"'
      CurrentIGNO=1018
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=C00331(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(161),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PREGEX_ir_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01013')
      RETURN
      END
      SUBROUTINE S01014(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00332,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00332(SSZ(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "PREGEX_ir_NMRG"'
      CurrentIGNO=1018
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=C00332(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(161),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "PREGEX_ir_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01014')
      RETURN
      END
      SUBROUTINE S01015(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "PREGEX_ir_NMRG"'
      CurrentIGNO=1018
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(161),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "PREGEX_ir_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01015')
      RETURN
      END
      SUBROUTINE S01016(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00209(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pxw"'
      CurrentAction2=
     *  ' in equation "PREGEX_ir_NMRG"'
      CurrentIGNO=1018
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      164)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=C00209(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(164),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(161),COLBF(164),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pxw"',
     *  ' in equation "PREGEX_ir_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01016')
      RETURN
      END
      SUBROUTINE S01023(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PREGIM_is"'
      CurrentIGNO=1026
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=-C00033(I00001,I00002,I00003)*C00173(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PREGIM_is"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01023')
      RETURN
      END
      SUBROUTINE S01024(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "PREGIM_is"'
      CurrentIGNO=1026
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=C00033(I00001,I00002,I00003)*C00173(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(165),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "PREGIM_is"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01024')
      RETURN
      END
      SUBROUTINE S01025(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "PREGIM_is"'
      CurrentIGNO=1026
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=C00033(I00001,I00002,I00003)*C00173(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(165),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "PREGIM_is"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01025')
      RETURN
      END
      SUBROUTINE S01026(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00375,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00375(SSZ(3),SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "PREGIM_is"'
      CurrentIGNO=1026
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=C00375(I00005,I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(165),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "PREGIM_is"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01026')
      RETURN
      END
      SUBROUTINE S01028(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ats"'
      CurrentAction2=
     *  ' in equation "PREGIM_is"'
      CurrentIGNO=1026
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      115)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=C00033(I00001,I00002,I00003)*C00347(I00001,I00002,I00003)
      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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(165),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ats"',
     *  ' in equation "PREGIM_is"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01028')
      RETURN
      END
      SUBROUTINE S01038(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00276,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00276(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "PWLDUSE"'
      CurrentIGNO=1034
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        5)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=C00276(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(169),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01038')
      RETURN
      END
      SUBROUTINE S01039(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "PWLDUSE"'
      CurrentIGNO=1034
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00048(I00001,I00003)*(1  -C00090(I00001,I00003))*
     *  C00086(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(169),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01039')
      RETURN
      END
      SUBROUTINE S01041(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "PWLDUSE"'
      CurrentIGNO=1034
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00048(I00001,I00003)*C00090(I00001,I00003)*
     *  C00088(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(169),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01041')
      RETURN
      END
      SUBROUTINE S01042(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "PWLDUSE"'
      CurrentIGNO=1034
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00050(I00001,I00003)*(1  -C00104(I00001,I00003))*
     *  C00100(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(169),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01042')
      RETURN
      END
      SUBROUTINE S01043(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "PWLDUSE"'
      CurrentIGNO=1034
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00050(I00001,I00003)*C00104(I00001,I00003)*
     *  C00102(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(169),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01043')
      RETURN
      END
      SUBROUTINE S01044(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfd"'
      CurrentAction2=
     *  ' in equation "PWLDUSE"'
      CurrentIGNO=1034
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       23)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)*(1  -
     *  C00123(I00001,I00004,I00003))*C00119(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(169),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01044')
      RETURN
      END
      SUBROUTINE S01045(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfm"'
      CurrentAction2=
     *  ' in equation "PWLDUSE"'
      CurrentIGNO=1034
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       26)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)*
     *  C00123(I00001,I00004,I00003)*C00121(I00001,I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(26),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(169),COLBF(26),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00278,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00278(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "PWLDUSE"'
      CurrentIGNO=1034
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=C00278(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00003)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(169),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "PWLDUSE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01046')
      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''',
     *    '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(151),ECHO1,
     *  ROWBF(157),COLBF(151),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00211,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(157),COLBF(167),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00218,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00993(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),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(164),ECHO1,
     *  ROWBF(158),COLBF(164),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00220,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(158),COLBF(168),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00221,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00996(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00276,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(159),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00277,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S00999(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01000(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00100,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 S01001(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00102,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 S01002(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01003(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(26),KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01004(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00278,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01005(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01006(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),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 S01007(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(169),ECHO1,
     *  ROWBF(159),COLBF(169),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00222,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PREGEX_ir_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01009(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00329,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01010(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00330,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01011(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01012(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(164),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
      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 S01013(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00331,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01014(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00332,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01015(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01016(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(164),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
      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(164),ECHO1,
     *  ROWBF(162),COLBF(164),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00209,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(170),ECHO1,
     *  ROWBF(162),COLBF(170),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00210,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(164),ECHO1,
     *  ROWBF(163),COLBF(164),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00209,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(171),ECHO1,
     *  ROWBF(163),COLBF(171),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,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''',
     *    '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(170),ECHO1,
     *  ROWBF(164),COLBF(170),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00210,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(172),ECHO1,
     *  ROWBF(164),COLBF(172),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00217,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S01023(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01024(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01025(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00173,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01026(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00375,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(165),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00376,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01028(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(115),KZC,DOEQ,STRHS,STRHNZ,
     *  C00033,C00347,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(165),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00376,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(120),ECHO1,
     *  ROWBF(165),COLBF(120),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(2),SSZ(1),1,1,1,1,C00377,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(165),COLBF(173),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00211,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(173),ECHO1,
     *  ROWBF(166),COLBF(173),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00211,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(166),COLBF(174),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00212,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(173),ECHO1,
     *  ROWBF(167),COLBF(173),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00211,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(167),COLBF(175),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00218,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(164),ECHO1,
     *  ROWBF(168),COLBF(164),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00220,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(168),COLBF(176),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00221,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01038(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00276,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01039(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(169),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00277,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01041(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00048,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01042(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00100,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 S01043(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00050,C00102,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 S01044(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01045(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(26),KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01046(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00278,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(177),ECHO1,
     *  ROWBF(169),COLBF(177),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00222,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01048(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxs"'
      CurrentAction2=
     *  ' in equation "QREGEX_ir_MARG"'
      CurrentIGNO=1036
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00034(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(170),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "QREGEX_ir_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01048')
      RETURN
      END
      SUBROUTINE S01050(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00209(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxw"'
      CurrentAction2=
     *  ' in equation "QREGEX_ir_MARG"'
      CurrentIGNO=1036
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      178)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=C00209(SSMP(SSMPST(1)-1+I00005),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(178),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(170),COLBF(178),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxw"',
     *  ' in equation "QREGEX_ir_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01050')
      RETURN
      END
      SUBROUTINE S01051(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxs"'
      CurrentAction2=
     *  ' in equation "QREGEX_ir_NMRG"'
      CurrentIGNO=1037
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00034(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(171),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "QREGEX_ir_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01051')
      RETURN
      END
      SUBROUTINE S01052(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00209(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxw"'
      CurrentAction2=
     *  ' in equation "QREGEX_ir_NMRG"'
      CurrentIGNO=1037
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      178)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=C00209(SSMP(SSMPST(2)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(178),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(171),COLBF(178),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxw"',
     *  ' in equation "QREGEX_ir_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01052')
      RETURN
      END
      SUBROUTINE S01065(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "QWLDOUT"'
      CurrentIGNO=1051
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "QWLDOUT"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=-C00220(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(178),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "QWLDOUT"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01065')
      RETURN
      END
      SUBROUTINE S01067(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00048(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "QWLDOUTU"'
      CurrentIGNO=1053
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "QWLDOUTU"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00048(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+I00001)+SSZ(19)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(179),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "QWLDOUTU"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01067')
      RETURN
      END
      SUBROUTINE S01068(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00050(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "QWLDOUTU"'
      CurrentIGNO=1053
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "QWLDOUTU"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       74)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-C00050(I00001,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(27)*(I00003-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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(179),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "QWLDOUTU"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01068')
      RETURN
      END
      SUBROUTINE S01069(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00044(SSZ(8),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "QWLDOUTU"'
      CurrentIGNO=1053
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "QWLDOUTU"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00044(SSMP(SSMPST(6)-1+I00001),I00004,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(I00003-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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(179),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "QWLDOUTU"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01069')
      RETURN
      END
      SUBROUTINE S01071(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00209(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "vxwfob"'
      CurrentAction2=
     *  ' in equation "TRADEBAL_i"'
      CurrentIGNO=1055
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      150)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-C00209(I00001,I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(180),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "vxwfob"',
     *  ' in equation "TRADEBAL_i"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01071')
      RETURN
      END
      SUBROUTINE S01072(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "viwcif"'
      CurrentAction2=
     *  ' in equation "TRADEBAL_i"'
      CurrentIGNO=1055
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      151)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00211(I00001,I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(180),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "viwcif"',
     *  ' in equation "TRADEBAL_i"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01072')
      RETURN
      END
      SUBROUTINE S01074(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00210,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00210(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "vxwreg"'
      CurrentAction2=
     *  ' in equation "TRADEBALANCE"'
      CurrentIGNO=1057
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "vxwreg"',
     *  ' in equation "TRADEBALANCE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      152)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-C00210(I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(152),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(181),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "vxwreg"',
     *  ' in equation "TRADEBALANCE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01074')
      RETURN
      END
      SUBROUTINE S01075(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00212,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00212(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "viwreg"'
      CurrentAction2=
     *  ' in equation "TRADEBALANCE"'
      CurrentIGNO=1057
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "viwreg"',
     *  ' in equation "TRADEBALANCE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      153)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00212(I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(153),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(181),COLBF(153),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "viwreg"',
     *  ' in equation "TRADEBALANCE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01075')
      RETURN
      END
      SUBROUTINE S01082(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "DBALCAR"'
      CurrentAction2=
     *  ' in equation "DBALCARATIO"'
      CurrentIGNO=1063
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "DBALCAR"',
     *  ' in equation "DBALCARATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'DBALCAR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      190)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=100*C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(190),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(183),COLBF(190),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "DBALCAR"',
     *  ' in equation "DBALCARATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01082')
      RETURN
      END
      SUBROUTINE S01085(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00052(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "DTBALR"'
      CurrentAction2=
     *  ' in equation "DTBALRATIO"'
      CurrentIGNO=1067
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "DTBALR"',
     *  ' in equation "DTBALRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      191)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=100*C00052(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(191),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(184),COLBF(191),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "DTBALR"',
     *  ' in equation "DTBALRATIO"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00010,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qgd"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00010(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qgd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00285,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00285(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=C00285(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(15)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00010,C00013,C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00010(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00086(SSMP(SSMPST(15)-1+I00001),I00002)-C00013(SSMP(SSMPST(15)-
     *  1+I00001),I00002)*C00076(SSMP(SSMPST(15)-1+I00001))*(1  -
     *  C00090(SSMP(SSMPST(15)-1+I00001),I00002))*
     *  C00086(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00286,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00286(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=C00286(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=C00013(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*C00088(SSMP(SSMPST(15)-1+
     *  I00001),I00002)-C00076(SSMP(SSMPST(15)-1+I00001))*
     *  C00090(SSMP(SSMPST(15)-1+I00001),I00002)*C00088(SSMP(SSMPST(15)-
     *  1+I00001),I00002))-C00013(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00088(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qpd"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00016(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qpd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,C00019,C00076,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00016(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00100(SSMP(SSMPST(15)-1+I00001),I00002)-C00019(SSMP(SSMPST(15)-
     *  1+I00001),I00002)*C00076(SSMP(SSMPST(15)-1+I00001))*(1  -
     *  C00104(SSMP(SSMPST(15)-1+I00001),I00002))*
     *  C00100(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=C00019(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*C00102(SSMP(SSMPST(15)-1+
     *  I00001),I00002)-C00019(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00102(SSMP(SSMPST(15)-1+I00001),I00002)-C00019(SSMP(SSMPST(15)-
     *  1+I00001),I00002)*C00076(SSMP(SSMPST(15)-1+I00001))*
     *  C00104(SSMP(SSMPST(15)-1+I00001),I00002)*C00102(SSMP(SSMPST(15)-
     *  1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qfd"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00024(SSMP(SSMPST(15)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qfd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01094')
      RETURN
      END
      SUBROUTINE S01095(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,C00026,C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfd"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       23)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00024(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00119(SSMP(SSMPST(15)-1+I00001),I00004,I00002)-
     *  C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*(1  -C00123(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002))*C00119(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01095')
      RETURN
      END
      SUBROUTINE S01096(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfm"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       26)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*C00121(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)-C00076(SSMP(SSMPST(15)-1+I00001))*
     *  C00123(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00121(SSMP(SSMPST(15)-1+I00001),I00004,I00002))-
     *  C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00121(SSMP(SSMPST(15)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(26),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(26),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00287,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00287(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=C00287(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00013(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+SSMP(SSMPST(15)-1+I00001))+SSZ(19)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00019(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(15)-1+I00001))+SSZ(27)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "TOTVALEN"'
      CurrentIGNO=1071
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(15)-1+
     *  I00001)))+SSZ(35)*(I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(185),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "TOTVALEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01100')
      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''',
     *    'QREGEX_ir_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01048(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(34),ECHO1,
     *  ROWBF(170),COLBF(34),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00036,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01050(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(178),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
      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 S01051(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01052(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(178),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
      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(178),ECHO1,
     *  ROWBF(172),COLBF(178),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00209,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(179),ECHO1,
     *  ROWBF(172),COLBF(179),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00210,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(178),ECHO1,
     *  ROWBF(173),COLBF(178),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00209,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(180),ECHO1,
     *  ROWBF(173),COLBF(180),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,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''',
     *    '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(179),ECHO1,
     *  ROWBF(174),COLBF(179),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00210,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(174),COLBF(181),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,C00217,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QREGIM_is',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(31),ECHO1,
     *  ROWBF(175),COLBF(31),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),SSZ(1),1,1,1,1,C00033,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(182),ECHO1,
     *  ROWBF(175),COLBF(182),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00211,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(182),ECHO1,
     *  ROWBF(176),COLBF(182),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00211,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(176),COLBF(183),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00212,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'QWLDIM_i',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(182),ECHO1,
     *  ROWBF(177),COLBF(182),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00211,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(177),COLBF(184),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00218,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01065(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),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(185),ECHO1,
     *  ROWBF(178),COLBF(185),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00221,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01067(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01068(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),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 S01069(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00044,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(186),ECHO1,
     *  ROWBF(179),COLBF(186),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00222,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01071(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(150),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 S01072(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(151),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(187),ECHO1,
     *  ROWBF(180),COLBF(187),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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 S01074(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(152),KZC,DOEQ,STRHS,STRHNZ,
     *  C00210,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01075(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(153),KZC,DOEQ,STRHS,STRHNZ,
     *  C00212,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(188),ECHO1,
     *  ROWBF(181),COLBF(188),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TRAEMTRADBAL',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(59),ECHO1,
     *  ROWBF(182),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(188),ECHO1,
     *  ROWBF(182),COLBF(188),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(189),ECHO1,
     *  ROWBF(182),COLBF(189),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DBALCARATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(183),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00223,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(189),ECHO1,
     *  ROWBF(183),COLBF(189),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01082(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(190),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DTBALRATIO',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(42),ECHO1,
     *  ROWBF(184),COLBF(42),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00224,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(184),COLBF(188),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01085(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(191),KZC,DOEQ,STRHS,STRHNZ,
     *  C00052,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOTVALEN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01086(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00010,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01087(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00285,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00010,C00013,C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01089(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00286,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01091(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01092(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,C00019,C00076,C00100,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 S01093(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00102,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 S01094(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01095(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,C00026,C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01096(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(26),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01097(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00287,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01098(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01099(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(192),ECHO1,
     *  ROWBF(185),COLBF(192),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  4,SSZ(1),1,1,1,1,1,C00225,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00026')
      RETURN
      END
      SUBROUTINE S01102(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00010,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qgd"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00010(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qgd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00288,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00288(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=C00288(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(15)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00013(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*(1  -C00090(SSMP(SSMPST(15)-1+
     *  I00001),I00002))*C00086(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00289,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00289(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pim"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pim"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pim',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        9)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=C00289(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(9),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(9),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pim"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=C00013(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*C00088(SSMP(SSMPST(15)-1+
     *  I00001),I00002)-C00076(SSMP(SSMPST(15)-1+I00001))*
     *  C00090(SSMP(SSMPST(15)-1+I00001),I00002)*C00088(SSMP(SSMPST(15)-
     *  1+I00001),I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qpd"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00016(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qpd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00100,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00019(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*(1  -C00104(SSMP(SSMPST(15)-1+
     *  I00001),I00002))*C00100(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00102,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=C00019(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*C00102(SSMP(SSMPST(15)-1+
     *  I00001),I00002)-C00019(SSMP(SSMPST(15)-1+I00001),I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*C00104(SSMP(SSMPST(15)-1+
     *  I00001),I00002)*C00102(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qfd"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00024(SSMP(SSMPST(15)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qfd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfd"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       23)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00076(SSMP(SSMPST(15)-1+I00001))*(1  -C00123(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002))*C00119(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfm"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       26)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  (C00076(SSMP(SSMPST(15)-1+I00001))*C00121(SSMP(SSMPST(15)-1+
     *  I00001),I00004,I00002)-C00076(SSMP(SSMPST(15)-1+I00001))*
     *  C00123(SSMP(SSMPST(15)-1+I00001),I00004,I00002)*
     *  C00121(SSMP(SSMPST(15)-1+I00001),I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(15)-1+I00001)+SSZ(2)*(I00004-1+SSZ(7)*
     *  (I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(26),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(26),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01112')
      RETURN
      END
      SUBROUTINE S01113(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00290,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00290(SSZ(15),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=C00290(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01113')
      RETURN
      END
      SUBROUTINE S01114(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00013(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+SSMP(SSMPST(15)-1+I00001))+SSZ(19)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      ENTRY=-C00019(SSMP(SSMPST(15)-1+I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+SSMP(SSMPST(15)-1+I00001))+SSZ(27)*
     *  (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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "TOTQUAEN"'
      CurrentIGNO=1073
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(15)  ! (all,i,EGY_COMM)
      RWN=I00001+SSZ(15)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-C00026(SSMP(SSMPST(15)-1+I00001),I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+SSMP(SSMPST(15)-1+
     *  I00001)))+SSZ(35)*(I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(186),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "TOTQUAEN"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01116')
      RETURN
      END
      SUBROUTINE S01125(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00233,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00233(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pop"'
      CurrentAction2=
     *  ' in equation "PRIVDMNDSEV"'
      CurrentIGNO=1112
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "PRIVDMNDSEV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      RWN=I00001+SSZ(32)*(I00002-1)
      ENTRY=-1.0+C00233(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(189),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "PRIVDMNDSEV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01125')
      RETURN
      END
      SUBROUTINE S01132(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      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 C00235(SSZ(32),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ypev"'
      CurrentAction2=
     *  ' in equation "UTILELASPRIVEV"'
      CurrentIGNO=1118
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ypev"',
     *  ' in equation "UTILELASPRIVEV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'ypev',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      201)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=0.0
      DO 2 I00001=1,SSZ(32)  ! SUM(i,UP_COMM
      RS1=RS1-C00235(I00001,I00002)
    2 CONTINUE  ! END SUM(i,UP_COMM
      ENTRY=-RS1
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(201),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(191),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ypev"',
     *  ' in equation "UTILELASPRIVEV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01132')
      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''',
     *    'TOTQUAEN',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01102(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00010,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01103(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00288,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00076,C00086,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01105(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(9),KZC,DOEQ,STRHS,STRHNZ,
     *  C00289,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,C00076,C00088,C00090,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01107(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00016,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01108(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00100,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 S01109(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,C00076,C00102,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 S01110(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  C00024,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01111(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00076,C00119,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01112(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(26),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,C00076,C00121,C00123,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01113(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,C00290,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01114(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00013,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01115(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),KZC,DOEQ,STRHS,STRHNZ,
     *  C00019,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00026,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(193),ECHO1,
     *  ROWBF(186),COLBF(193),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  4,SSZ(1),1,1,1,1,1,C00225,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'AVPRICE',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(161),ECHO1,
     *  ROWBF(187),COLBF(161),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(187),COLBF(192),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(193),ECHO1,
     *  ROWBF(187),COLBF(193),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,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(187),COLBF(194),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'GOVUSHD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(188),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(197),ECHO1,
     *  ROWBF(188),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(202),ECHO1,
     *  ROWBF(188),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''',
     *    'PRIVDMNDSEV',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,AXSUN,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00233,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(201),ECHO1,
     *  ROWBF(189),COLBF(201),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(32),SSZ(1),1,1,1,1,1,C00233,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(203),ECHO1,
     *  ROWBF(189),COLBF(203),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PRIVATEUEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(44),ECHO1,
     *  ROWBF(190),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(198),ECHO1,
     *  ROWBF(190),COLBF(198),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00234,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(190),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''',
     *    'UTILELASPRIVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(196),ECHO1,
     *  ROWBF(191),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01132(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(201),KZC,DOEQ,STRHS,STRHNZ,
     *  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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(203),ECHO1,
     *  ROWBF(191),COLBF(203),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(32),SSZ(1),1,1,1,1,1,C00235,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'DPARAVEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(127),ECHO1,
     *  ROWBF(192),COLBF(127),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(128),ECHO1,
     *  ROWBF(192),COLBF(128),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00240,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(129),ECHO1,
     *  ROWBF(192),COLBF(129),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00241,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(205),ECHO1,
     *  ROWBF(192),COLBF(205),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'UTILITELASTICEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(195),ECHO1,
     *  ROWBF(193),COLBF(195),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(196),ECHO1,
     *  ROWBF(193),COLBF(196),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00177,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(205),ECHO1,
     *  ROWBF(193),COLBF(205),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'PCONSEXPEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(127),ECHO1,
     *  ROWBF(194),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(195),ECHO1,
     *  ROWBF(194),COLBF(195),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(196),ECHO1,
     *  ROWBF(194),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
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(200),ECHO1,
     *  ROWBF(194),COLBF(200),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(201),ECHO1,
     *  ROWBF(194),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''',
     *    'GOVCONSEXPEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(128),ECHO1,
     *  ROWBF(195),COLBF(128),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(195),ECHO1,
     *  ROWBF(195),COLBF(195),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(200),ECHO1,
     *  ROWBF(195),COLBF(200),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(202),ECHO1,
     *  ROWBF(195),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''',
     *    'SAVINGEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(129),ECHO1,
     *  ROWBF(196),COLBF(129),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(195),ECHO1,
     *  ROWBF(196),COLBF(195),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(200),ECHO1,
     *  ROWBF(196),COLBF(200),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(204),ECHO1,
     *  ROWBF(196),COLBF(204),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00027')
      RETURN
      END
      SUBROUTINE S01156(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00242,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00242(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pop"'
      CurrentAction2=
     *  ' in equation "INCOME_EQUIV"'
      CurrentIGNO=1149
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "INCOME_EQUIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=1.0
      RS2=C00242(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(198),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "INCOME_EQUIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01156')
      RETURN
      END
      SUBROUTINE S01157(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,C00227,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00192(SSZ(1))
      REAL C00227(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dppriv"'
      CurrentAction2=
     *  ' in equation "INCOME_EQUIV"'
      CurrentIGNO=1149
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "INCOME_EQUIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      127)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=REAL(C00227(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        ErrorLogeNo=1
        NumActiveInd=1
        ErrorRVal1=RS1
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00192(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(127),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(198),COLBF(127),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "INCOME_EQUIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01157')
      RETURN
      END
      SUBROUTINE S01158(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00193,C00228,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00193(SSZ(1))
      REAL C00228(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dpgov"'
      CurrentAction2=
     *  ' in equation "INCOME_EQUIV"'
      CurrentIGNO=1149
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "INCOME_EQUIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      128)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=REAL(C00228(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        ErrorLogeNo=2
        NumActiveInd=1
        ErrorRVal1=RS1
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00193(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(128),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(198),COLBF(128),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "INCOME_EQUIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01158')
      RETURN
      END
      SUBROUTINE S01159(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00194,C00229,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00194(SSZ(1))
      REAL C00229(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dpsave"'
      CurrentAction2=
     *  ' in equation "INCOME_EQUIV"'
      CurrentIGNO=1149
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "INCOME_EQUIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      129)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=REAL(C00229(I00002))
      IF(RS1.LE.0.0) THEN
        IER=32
        ErrorLogeNo=3
        NumActiveInd=1
        ErrorRVal1=RS1
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=-C00194(I00002)*LOG(RS1)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(129),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(198),COLBF(129),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "INCOME_EQUIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01159')
      RETURN
      END
      SUBROUTINE S01162(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00242,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00242(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "yev"'
      CurrentAction2=
     *  ' in equation "INCOME_EQUIV"'
      CurrentIGNO=1149
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yev"',
     *  ' in equation "INCOME_EQUIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yev',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      200)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=-1.0
      RS2=C00242(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=2
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      ENTRY=RS3
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(200),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(198),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "yev"',
     *  ' in equation "INCOME_EQUIV"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01162')
      RETURN
      END
      SUBROUTINE S01163(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00226(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "yev"'
      CurrentAction2=
     *  ' in equation "EVREG"'
      CurrentIGNO=1151
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "yev"',
     *  ' in equation "EVREG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'yev',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      200)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-C00226(I00002)/100.
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(200),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(199),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "yev"',
     *  ' in equation "EVREG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01163')
      RETURN
      END
      SUBROUTINE S01167(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "psave"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "psave"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'psave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        1)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=0.01  *C00243(I00002)*C00009(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(1),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(1),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "psave"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00064,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qgd"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00063(I00001,I00002)+
     *  C00064(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qgd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00036,C00243,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00333(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00333(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      DO 4 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00036(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=0.01  *C00243(I00002)*C00034(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01169')
      RETURN
      END
      SUBROUTINE S01170(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00076,C00086,C00090,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*C00076(I00001)*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01170')
      RETURN
      END
      SUBROUTINE S01172(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00076,C00088,C00090,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=0.01  *C00243(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*(C00076(I00001)*C00088(I00001,I00002)-
     *  C00076(I00001)*C00090(I00001,I00002)*C00088(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qpd"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00058(I00001,I00002)+
     *  C00059(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qpd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01173')
      RETURN
      END
      SUBROUTINE S01174(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00100,C00104,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*(1  -
     *  C00104(I00001,I00002))*C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01174')
      RETURN
      END
      SUBROUTINE S01175(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00102,C00104,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*C00102(I00001,I00002)-
     *  0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*C00104(I00001,I00002)*
     *  C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01175')
      RETURN
      END
      SUBROUTINE S01176(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00070,C00243,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00001=1,SSZ(9)  ! (all,i,NSAV_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00070(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      DO 4 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00045(SSMP(SSMPST(7)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00053,C00054,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qfd"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qfd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01177')
      RETURN
      END
      SUBROUTINE S01178(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00119,C00123,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfd"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       23)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*C00076(I00001)*(1  -
     *  C00123(I00001,I00004,I00002))*C00119(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01178')
      RETURN
      END
      SUBROUTINE S01179(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00121,C00123,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfm"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       26)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*(C00076(I00001)*
     *  C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(26),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(26),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "kb"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=0.01  *C00243(I00002)*C00031(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pcgds"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       29)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-0.01  *C00243(I00002)*C00078(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(29),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01181')
      RETURN
      END
      SUBROUTINE S01182(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00072,C00074,C00243,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxs"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00072(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00074(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01182')
      RETURN
      END
      SUBROUTINE S01183(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00293(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00293(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01183')
      RETURN
      END
      SUBROUTINE S01185(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "DVCO2TRA"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "DVCO2TRA"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'DVCO2TRA',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       59)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-0.01  *C00243(I00002)*100.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(59),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(59),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "DVCO2TRA"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01185')
      RETURN
      END
      SUBROUTINE S01186(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+I00001)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01186')
      RETURN
      END
      SUBROUTINE S01187(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',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)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(27)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00068,C00243,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 4 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00068(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
    4 CONTINUE
      DO 6 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(83),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ams"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       85)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00032(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01189')
      RETURN
      END
      SUBROUTINE S01193(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 2 I00001=1,SSZ(35)  ! (all,i,FIRM_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00116(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(35)*(I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01193')
      RETURN
      END
      SUBROUTINE S01194(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "aosec"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aosec"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       92)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "aosec"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01194')
      RETURN
      END
      SUBROUTINE S01196(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "aoall"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aoall"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       94)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(7)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(94),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(94),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "aoall"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00243,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00334(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tx"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=C00334(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      DO 5 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 4 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00034(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01197')
      RETURN
      END
      SUBROUTINE S01198(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00243,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "txs"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=0.01  *C00243(I00002)*C00034(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
    4 CONTINUE
      DO 6 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 5 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00034(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
    6 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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
    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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01198')
      RETURN
      END
      SUBROUTINE S01199(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00348,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00348(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=C00348(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01199')
      RETURN
      END
      SUBROUTINE S01203(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00243,C00244,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00243(SSZ(1))
      REAL C00244(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pt"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pt"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      120)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=0.01  *C00243(I00002)*C00244(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00005
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(120),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pt"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01203')
      RETURN
      END
      SUBROUTINE S01204(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,C00195,C00226,C00227,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00192(SSZ(1))
      REAL C00195(SSZ(1))
      REAL C00226(SSZ(1))
      REAL C00227(SSZ(1))
      REAL C00242(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dppriv"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      127)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=C00227(I00002)
      RS2=C00195(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        ErrorLogeNo=1
        NumActiveInd=1
        ErrorRVal1=RS4
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00242(I00002)*C00226(I00002)*C00192(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(127),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(127),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01204')
      RETURN
      END
      SUBROUTINE S01205(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00193,C00196,C00226,C00228,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00193(SSZ(1))
      REAL C00196(SSZ(1))
      REAL C00226(SSZ(1))
      REAL C00228(SSZ(1))
      REAL C00242(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dpgov"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      128)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=C00228(I00002)
      RS2=C00196(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=2
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        ErrorLogeNo=2
        NumActiveInd=1
        ErrorRVal1=RS4
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00242(I00002)*C00226(I00002)*C00193(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(128),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(128),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01205')
      RETURN
      END
      SUBROUTINE S01206(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00194,C00197,C00226,C00229,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00194(SSZ(1))
      REAL C00197(SSZ(1))
      REAL C00226(SSZ(1))
      REAL C00229(SSZ(1))
      REAL C00242(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dpsave"'
      CurrentAction2=
     *  ' in equation "EV_DECOMPOSITION"'
      CurrentIGNO=1159
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      129)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=C00229(I00002)
      RS2=C00197(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=3
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        ErrorLogeNo=3
        NumActiveInd=1
        ErrorRVal1=RS4
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00242(I00002)*C00226(I00002)*C00194(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(129),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(201),COLBF(129),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "EV_DECOMPOSITION"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01206')
      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''',
     *    'SAVEUEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(199),ECHO1,
     *  ROWBF(197),COLBF(199),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(204),ECHO1,
     *  ROWBF(197),COLBF(204),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'INCOME_EQUIV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01156(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00242,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01157(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(127),KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,C00227,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01158(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(128),KZC,DOEQ,STRHS,STRHNZ,
     *  C00193,C00228,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01159(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(129),KZC,DOEQ,STRHS,STRHNZ,
     *  C00194,C00229,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(198),COLBF(142),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(198),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01162(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(200),KZC,DOEQ,STRHS,STRHNZ,
     *  C00242,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'EVREG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01163(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(200),KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(206),ECHO1,
     *  ROWBF(199),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''',
     *    'EVWLD',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(206),ECHO1,
     *  ROWBF(200),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(200),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''',
     *    'EV_DECOMPOSITION',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01167(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(1),KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01168(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00064,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00036,C00243,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 S01170(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00076,C00086,C00090,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(201),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00292,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01172(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00076,C00088,C00090,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01174(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00100,C00104,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01175(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00102,C00104,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01176(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00070,C00243,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  C00053,C00054,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01178(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00119,C00123,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01179(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(26),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00121,C00123,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01180(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(29),KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01182(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00072,C00074,C00243,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01183(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,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(44),ECHO1,
     *  ROWBF(201),COLBF(44),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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01185(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(59),KZC,DOEQ,STRHS,STRHNZ,
     *  C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01186(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01187(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01188(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00068,C00243,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(87),ECHO1,
     *  ROWBF(201),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(35),SSZ(1),1,1,1,1,1,C00313,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(88),ECHO1,
     *  ROWBF(201),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00314,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(201),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00315,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01193(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01194(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(92),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(93),ECHO1,
     *  ROWBF(201),COLBF(93),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 S01196(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(94),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00243,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 S01198(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00034,C00243,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01199(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00348,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(114),ECHO1,
     *  ROWBF(201),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00349,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(201),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),SSZ(1),1,1,1,1,1,C00350,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(116),ECHO1,
     *  ROWBF(201),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00351,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01203(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(120),KZC,DOEQ,STRHS,STRHNZ,
     *  C00243,C00244,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01204(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(127),KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,C00195,C00226,C00227,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01205(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(128),KZC,DOEQ,STRHS,STRHNZ,
     *  C00193,C00196,C00226,C00228,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01206(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(129),KZC,DOEQ,STRHS,STRHNZ,
     *  C00194,C00197,C00226,C00229,C00242,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(208),ECHO1,
     *  ROWBF(201),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('M00028')
      RETURN
      END
      SUBROUTINE S01211(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00082,C00175,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00043(SSZ(1))
      REAL C00082(SSZ(1))
      REAL C00175(SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pxwwld"'
      CurrentAction2=
     *  ' in equation "CONT_EV_CO2TR"'
      CurrentIGNO=1163
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxwwld"',
     *  ' in equation "CONT_EV_CO2TR"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxwwld',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      172)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=C00243(I00002)*0.01  *(C00175(I00002)-C00082(I00002))*
     *  C00043(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(172),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(203),COLBF(172),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pxwwld"',
     *  ' in equation "CONT_EV_CO2TR"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01211')
      RETURN
      END
      SUBROUTINE S01213(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,C00195,C00226,C00227,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00192(SSZ(1))
      REAL C00195(SSZ(1))
      REAL C00226(SSZ(1))
      REAL C00227(SSZ(1))
      REAL C00242(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dppriv"'
      CurrentAction2=
     *  ' in equation "CNT_WEV_dpar"'
      CurrentIGNO=1165
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dppriv"',
     *  ' in equation "CNT_WEV_dpar"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dppriv',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      127)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=C00227(I00002)
      RS2=C00195(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        ErrorLogeNo=1
        NumActiveInd=1
        ErrorRVal1=RS4
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00242(I00002)*C00226(I00002)*C00192(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(127),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(204),COLBF(127),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dppriv"',
     *  ' in equation "CNT_WEV_dpar"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00193,C00196,C00226,C00228,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00193(SSZ(1))
      REAL C00196(SSZ(1))
      REAL C00226(SSZ(1))
      REAL C00228(SSZ(1))
      REAL C00242(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dpgov"'
      CurrentAction2=
     *  ' in equation "CNT_WEV_dpar"'
      CurrentIGNO=1165
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpgov"',
     *  ' in equation "CNT_WEV_dpar"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpgov',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      128)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=C00228(I00002)
      RS2=C00196(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=2
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        ErrorLogeNo=2
        NumActiveInd=1
        ErrorRVal1=RS4
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00242(I00002)*C00226(I00002)*C00193(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(128),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(204),COLBF(128),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dpgov"',
     *  ' in equation "CNT_WEV_dpar"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00194,C00197,C00226,C00229,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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 C00194(SSZ(1))
      REAL C00197(SSZ(1))
      REAL C00226(SSZ(1))
      REAL C00229(SSZ(1))
      REAL C00242(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "dpsave"'
      CurrentAction2=
     *  ' in equation "CNT_WEV_dpar"'
      CurrentIGNO=1165
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "dpsave"',
     *  ' in equation "CNT_WEV_dpar"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'dpsave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      129)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=C00229(I00002)
      RS2=C00197(I00002)
      IF(RS2.NE.0.0) THEN
        RS3=RS1/RS2
      ELSE
        RS3=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=3
         NumActiveInd=1
         ErrorRVal1=RS1
         ErrorRVal2=RS2
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
        END IF
      END IF
      RS4=REAL(RS3)
      IF(RS4.LE.0.0) THEN
        IER=32
        ErrorLogeNo=3
        NumActiveInd=1
        ErrorRVal1=RS4
        ErrorIndName(1)='r           '
        ErrorIndVal(1)=I00002
        ErrorIndSetNo(1)=1
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      ENTRY=0.01  *C00242(I00002)*C00226(I00002)*C00194(I00002)*LOG(RS4)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(129),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(204),COLBF(129),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "dpsave"',
     *  ' in equation "CNT_WEV_dpar"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01215')
      RETURN
      END
      SUBROUTINE S01217(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00226(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pop"'
      CurrentAction2=
     *  ' in equation "CONT_EV_pop"'
      CurrentIGNO=1167
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_pop"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-0.01  *C00226(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(205),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_pop"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01217')
      RETURN
      END
      SUBROUTINE S01219(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_E"'
      CurrentIGNO=1217
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_E"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RWN=I00001+SSZ(6)*(I00002-1)
      ENTRY=-0.01  *C00243(I00002)*C00070(SSMP(SSMPST(7)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_E"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01219')
      RETURN
      END
      SUBROUTINE S01221(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_E"'
      CurrentIGNO=1217
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "CONT_EV_alleffir_E"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RWN=I00001+SSZ(6)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00068(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "CONT_EV_alleffir_E"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "CNTalleffir"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_E"'
      CurrentIGNO=1217
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_E"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'CNTalleffir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      237)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RWN=I00001+SSZ(6)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(5)-1+I00001)+SSZ(8)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(237),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(230),COLBF(237),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_E"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00064,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qgd"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qgd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        4)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-0.01  *C00243(I00002)*(C00063(I00001,I00002)+
     *  C00064(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(4),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(4),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qgd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00291,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pm"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00291(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(5),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00076,C00086,C00090,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgd"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        6)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-0.01  *C00243(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*C00076(I00001)*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(6),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(6),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01225')
      RETURN
      END
      SUBROUTINE S01227(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00076,C00088,C00090,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tgm"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tgm"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'tgm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       10)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=0.01  *C00243(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*(C00076(I00001)*C00088(I00001,I00002)-
     *  C00076(I00001)*C00090(I00001,I00002)*C00088(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(10),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(10),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tgm"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qpd"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qpd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       12)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-0.01  *C00243(I00002)*(C00058(I00001,I00002)+
     *  C00059(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(12),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(12),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qpd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00100,C00104,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpd"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       13)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*(1  -
     *  C00104(I00001,I00002))*C00100(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(13),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00102,C00104,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atpm"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atpm"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'atpm',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       16)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*C00102(I00001,I00002)-
     *  0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*C00104(I00001,I00002)*
     *  C00102(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(16),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(16),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atpm"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01230')
      RETURN
      END
      SUBROUTINE S01231(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-0.01  *C00243(I00002)*C00070(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01231')
      RETURN
      END
      SUBROUTINE S01232(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00053,C00054,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qfd"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qfd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qfd',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       22)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(22),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qfd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00119,C00123,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfd"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       23)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*C00076(I00001)*(1  -
     *  C00123(I00001,I00004,I00002))*C00119(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(23),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfd"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01233')
      RETURN
      END
      SUBROUTINE S01234(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00121,C00123,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tfm"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "tfm"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       26)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*(C00076(I00001)*
     *  C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00004-1+SSZ(7)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(26),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(26),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tfm"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01234')
      RETURN
      END
      SUBROUTINE S01235(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00072,C00074,C00243,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qxs"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qxs"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qxs',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       31)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-0.01  *C00243(I00002)*C00072(I00001,I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00002-1+SSZ(1)*(I00003-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
         LRW(COLUMN)=RWN
         ADR(COLUMN)=NZ
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    4 CONTINUE
      DO 5 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=-0.01  *C00243(I00002)*C00074(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(31),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
    5 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(31),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qxs"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01235')
      RETURN
      END
      SUBROUTINE S01236(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00300(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "NCTAXB"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "NCTAXB"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'NCTAXB',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       41)
      DO     1 I=1,NCL
      LRW(I)=0
    1 CONTINUE
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00300(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=C00008(I00002)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(41),1).NE.'x'
        IF(USEIT) THEN
         IF(LRW(COLUMN).NE.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 ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(41),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    3 CONTINUE
    2 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "NCTAXB"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01236')
      RETURN
      END
      SUBROUTINE S01238(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qg"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qg"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qg',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       70)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-0.01  *C00243(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(17)-1+I00001)+SSZ(19)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(70),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(70),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qg"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01238')
      RETURN
      END
      SUBROUTINE S01239(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qp"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qp"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qp',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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(26)-1+I00001)+SSZ(27)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qp"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01239')
      RETURN
      END
      SUBROUTINE S01240(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qf"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qf"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       83)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      ENTRY=-0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+I00001))+SSZ(35)*
     *  (I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qf"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "CNTalleffir"'
      CurrentAction2=
     *  ' in equation "CONT_EV_alleffir_T"'
      CurrentIGNO=1218
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'CNTalleffir',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      237)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(6)-1+I00001)+SSZ(8)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(237),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(231),COLBF(237),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "CNTalleffir"',
     *  ' in equation "CONT_EV_alleffir_T"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "psave"'
      CurrentAction2=
     *  ' in equation "CNT_EV_cgdsr"'
      CurrentIGNO=1222
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "psave"',
     *  ' in equation "CNT_EV_cgdsr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'psave',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(        1)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=0.01  *C00243(I00002)*C00009(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(1),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(233),COLBF(1),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "psave"',
     *  ' in equation "CNT_EV_cgdsr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00078(SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pcgds"'
      CurrentAction2=
     *  ' in equation "CNT_EV_cgdsr"'
      CurrentIGNO=1222
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pcgds"',
     *  ' in equation "CNT_EV_cgdsr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pcgds',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       29)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-0.01  *C00243(I00002)*C00078(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(29),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(233),COLBF(29),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pcgds"',
     *  ' in equation "CNT_EV_cgdsr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01243')
      RETURN
      END
      SUBROUTINE S01244(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00078,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL C00078(SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pxwwld"'
      CurrentAction2=
     *  ' in equation "CNT_EV_cgdsr"'
      CurrentIGNO=1222
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pxwwld"',
     *  ' in equation "CNT_EV_cgdsr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pxwwld',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      172)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-0.01  *C00243(I00002)*(-C00078(I00002)+C00009(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(172),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(233),COLBF(172),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pxwwld"',
     *  ' in equation "CNT_EV_cgdsr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01244')
      RETURN
      END
      SUBROUTINE S01246(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "CONT_EV_endwr"'
      CurrentIGNO=1224
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00045(SSMP(SSMPST(7)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01246')
      RETURN
      END
      SUBROUTINE S01247(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "kb"'
      CurrentAction2=
     *  ' in equation "CONT_EV_endwr"'
      CurrentIGNO=1224
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_endwr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=0.01  *C00243(I00002)*C00031(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_endwr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01247')
      RETURN
      END
      SUBROUTINE S01248(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      REAL RS1
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pop"'
      CurrentAction2=
     *  ' in equation "CONT_EV_endwr"'
      CurrentIGNO=1224
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      RS1=0.0
      DO 2 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      RS1=RS1-C00045(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001)),I00002)
    2 CONTINUE  ! END SUM(i,ENDW_COMM
      ENTRY=-0.01  *C00243(I00002)*(RS1+C00031(I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(234),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "qo"'
      CurrentAction2=
     *  ' in equation "CONT_EV_endwir"'
      CurrentIGNO=1226
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'qo',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       18)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RWN=I00001+SSZ(6)*(I00002-1)
      ENTRY=-0.01  *C00243(I00002)*C00045(SSMP(SSMPST(7)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+I00001))+SSZ(9)*
     *  (I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(18),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(235),COLBF(18),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "qo"',
     *  ' in equation "CONT_EV_endwir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pop"'
      CurrentAction2=
     *  ' in equation "CONT_EV_endwir"'
      CurrentIGNO=1226
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RWN=I00001+SSZ(6)*(I00002-1)
      ENTRY=0.01  *C00243(I00002)*C00045(SSMP(SSMPST(7)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(235),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_endwir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ams"'
      CurrentAction2=
     *  ' in equation "CONT_EV_techr"'
      CurrentIGNO=1228
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_techr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       85)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00032(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(236),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_techr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01253')
      RETURN
      END
      SUBROUTINE S01257(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "CONT_EV_techr"'
      CurrentIGNO=1228
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "CONT_EV_techr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 2 I00001=1,SSZ(35)  ! (all,i,FIRM_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00116(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(35)*(I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(236),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "CONT_EV_techr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01257')
      RETURN
      END
      SUBROUTINE S01258(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "aosec"'
      CurrentAction2=
     *  ' in equation "CONT_EV_techr"'
      CurrentIGNO=1228
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aosec"',
     *  ' in equation "CONT_EV_techr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       92)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(236),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "aosec"',
     *  ' in equation "CONT_EV_techr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01258')
      RETURN
      END
      SUBROUTINE S01260(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "aoall"'
      CurrentAction2=
     *  ' in equation "CONT_EV_techr"'
      CurrentIGNO=1228
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aoall"',
     *  ' in equation "CONT_EV_techr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       94)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(7)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(94),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(236),COLBF(94),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "aoall"',
     *  ' in equation "CONT_EV_techr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01260')
      RETURN
      END
      SUBROUTINE S01261(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00348,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00348(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "CONT_EV_techr"'
      CurrentIGNO=1228
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "CONT_EV_techr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=C00348(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(236),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "CONT_EV_techr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01261')
      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''',
     *    'WORLDEV',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(208),ECHO1,
     *  ROWBF(202),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(202),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''',
     *    'CONT_EV_CO2TR',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(59),ECHO1,
     *  ROWBF(203),COLBF(59),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00243,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01211(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(172),KZC,DOEQ,STRHS,STRHNZ,
     *  C00043,C00082,C00175,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(203),COLBF(210),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CNT_WEV_dpar',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01213(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(127),KZC,DOEQ,STRHS,STRHNZ,
     *  C00192,C00195,C00226,C00227,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01214(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(128),KZC,DOEQ,STRHS,STRHNZ,
     *  C00193,C00196,C00226,C00228,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01215(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(129),KZC,DOEQ,STRHS,STRHNZ,
     *  C00194,C00197,C00226,C00229,C00242,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(211),ECHO1,
     *  ROWBF(204),COLBF(211),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01217(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00226,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(212),ECHO1,
     *  ROWBF(205),COLBF(212),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_alleffir_E',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01219(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(230),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(6),SSZ(1),1,1,1,1,1,C00322,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01221(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00068,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(237),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_alleffir_T',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01223(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(4),KZC,DOEQ,STRHS,STRHNZ,
     *  C00063,C00064,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  C00291,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01225(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(6),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00076,C00086,C00090,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(9),ECHO1,
     *  ROWBF(231),COLBF(9),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00292,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01227(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(10),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00076,C00088,C00090,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(12),KZC,DOEQ,STRHS,STRHNZ,
     *  C00058,C00059,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(13),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00100,C00104,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(16),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00076,C00102,C00104,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01231(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00070,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01232(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(22),KZC,DOEQ,STRHS,STRHNZ,
     *  C00053,C00054,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(23),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00119,C00123,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01234(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(26),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00076,C00121,C00123,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01235(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(31),KZC,DOEQ,STRHS,STRHNZ,
     *  C00072,C00074,C00243,
     *  MCO,ENT,ICN,ADR,LRW,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01236(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(41),KZC,DOEQ,STRHS,STRHNZ,
     *  C00008,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(44),ECHO1,
     *  ROWBF(231),COLBF(44),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00263,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01238(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(70),KZC,DOEQ,STRHS,STRHNZ,
     *  C00065,C00066,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01239(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(74),KZC,DOEQ,STRHS,STRHNZ,
     *  C00060,C00061,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01240(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(83),KZC,DOEQ,STRHS,STRHNZ,
     *  C00055,C00056,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(237),KZC,DOEQ,STRHS,STRHNZ,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CNT_EV_cgdsr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01242(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(1),KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(29),KZC,DOEQ,STRHS,STRHNZ,
     *  C00078,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01244(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(172),KZC,DOEQ,STRHS,STRHNZ,
     *  C00009,C00078,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(233),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
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_endwr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01246(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01247(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01248(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(240),ECHO1,
     *  ROWBF(234),COLBF(240),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_endwir',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,AXSUN,
     *  KSTEP,SMND(18),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,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,AXSUN,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,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(235),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''',
     *    'CONT_EV_techr',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,AXSUN,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(87),ECHO1,
     *  ROWBF(236),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(35),SSZ(1),1,1,1,1,1,C00313,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(88),ECHO1,
     *  ROWBF(236),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),SSZ(1),1,1,1,1,1,C00314,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,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(236),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00315,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01257(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01258(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(92),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(93),ECHO1,
     *  ROWBF(236),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00302,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01260(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(94),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01261(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00348,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(114),ECHO1,
     *  ROWBF(236),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00349,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(236),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),SSZ(1),1,1,1,1,1,C00350,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(116),ECHO1,
     *  ROWBF(236),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00351,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(242),ECHO1,
     *  ROWBF(236),COLBF(242),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00029')
      RETURN
      END
      SUBROUTINE S01266(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "aosec"'
      CurrentAction2=
     *  ' in equation "CONT_EV_tech_aor"'
      CurrentIGNO=1230
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aosec"',
     *  ' in equation "CONT_EV_tech_aor"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       92)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(92),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(237),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
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "aosec"',
     *  ' in equation "CONT_EV_tech_aor"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01266')
      RETURN
      END
      SUBROUTINE S01268(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "aoall"'
      CurrentAction2=
     *  ' in equation "CONT_EV_tech_aor"'
      CurrentIGNO=1230
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "aoall"',
     *  ' in equation "CONT_EV_tech_aor"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       94)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(7)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(94),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(237),COLBF(94),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "aoall"',
     *  ' in equation "CONT_EV_tech_aor"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01268')
      RETURN
      END
      SUBROUTINE S01273(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "afall"'
      CurrentAction2=
     *  ' in equation "CONT_EV_tech_afr"'
      CurrentIGNO=1234
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "afall"',
     *  ' in equation "CONT_EV_tech_afr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       90)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 2 I00001=1,SSZ(35)  ! (all,i,FIRM_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00116(I00001,I00004,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(35)*(I00004-1+SSZ(7)*(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 ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(239),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "afall"',
     *  ' in equation "CONT_EV_tech_afr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01273')
      RETURN
      END
      SUBROUTINE S01275(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00352,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00352(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "atm"'
      CurrentAction2=
     *  ' in equation "CONT_EV_tech_atrr"'
      CurrentIGNO=1238
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "atm"',
     *  ' in equation "CONT_EV_tech_atrr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      113)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      ENTRY=C00352(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(113),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(241),COLBF(113),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "atm"',
     *  ' in equation "CONT_EV_tech_atrr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01275')
      RETURN
      END
      SUBROUTINE S01280(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "ams"'
      CurrentAction2=
     *  ' in equation "CONT_EV_tech_amsr"'
      CurrentIGNO=1242
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_tech_amsr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(       85)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      ENTRY=-0.01  *C00243(I00002)*C00032(I00001,I00003,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001+SSZ(2)*(I00003-1+SSZ(1)*(I00002-1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(85),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    2 CONTINUE
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(243),COLBF(85),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "ams"',
     *  ' in equation "CONT_EV_tech_amsr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01280')
      RETURN
      END
      SUBROUTINE S01282(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "kb"'
      CurrentAction2=
     *  ' in equation "CONT_EV_kbr"'
      CurrentIGNO=1246
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_kbr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'kb',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       28)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=0.01  *C00243(I00002)*C00031(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(28),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(245),COLBF(28),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "kb"',
     *  ' in equation "CONT_EV_kbr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01282')
      RETURN
      END
      SUBROUTINE S01283(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER RWN,NCL,NZ,N0,N1,N2,I,N3
      INTEGER COLUMN,NUMVC,NCP(NUMVC)
      REAL ENTRY
      INTEGER MCO,ICN(MCO)
      REAL ENT(MCO)
      INTEGER MMSBT,NSUBTO
      LOGICAL CALCNEWTERRSUBMATRIX
      INTEGER NEWTERR_DIM
      REAL NEWTERR(NEWTERR_DIM)
      INTEGER MMNCOL,LHSMAP(MMNCOL),MMNROW,DMSTSL,NMSTSL,DIM1_MSTSOL
      CHARACTER SHENV(MMNCOL,MMSBT+1)
      REAL XSHOCK(MMNCOL),CUMCOL(MMNROW,MMSBT+1)
      REAL MSTSOL(DIM1_MSTSOL,MMSBT+1,DMSTSL)
      REAL XSHOC2(MMNCOL),XSHOC3(MMNCOL)
      LOGICAL FMRHSC
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL C00243(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pop"'
      CurrentAction2=
     *  ' in equation "CONT_EV_kbr"'
      CurrentIGNO=1246
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_kbr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'pop',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(       44)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RWN=I00002
      ENTRY=-0.01  *C00243(I00002)*C00031(I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00002
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(44),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(245),COLBF(44),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pop"',
     *  ' in equation "CONT_EV_kbr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01283')
      RETURN
      END
      SUBROUTINE S01285(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "EXPPRICE_MARG"'
      CurrentIGNO=1267
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=C00338(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(246),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "EXPPRICE_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01285')
      RETURN
      END
      SUBROUTINE S01286(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00339(SSZ(3),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "EXPPRICE_MARG"'
      CurrentIGNO=1267
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=C00339(I00005,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(246),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "EXPPRICE_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01286')
      RETURN
      END
      SUBROUTINE S01287(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "EXPPRICE_MARG"'
      CurrentIGNO=1267
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=C00250(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(246),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "EXPPRICE_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01287')
      RETURN
      END
      SUBROUTINE S01288(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "px_ir"'
      CurrentAction2=
     *  ' in equation "EXPPRICE_MARG"'
      CurrentIGNO=1267
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      252)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(252),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(246),COLBF(252),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "px_ir"',
     *  ' in equation "EXPPRICE_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01288')
      RETURN
      END
      SUBROUTINE S01289(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "EXPPRICE_NMRG"'
      CurrentIGNO=1268
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=C00340(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(247),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "EXPPRICE_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01289')
      RETURN
      END
      SUBROUTINE S01290(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(4),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "EXPPRICE_NMRG"'
      CurrentIGNO=1268
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=C00341(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(247),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "EXPPRICE_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01290')
      RETURN
      END
      SUBROUTINE S01291(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),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(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "EXPPRICE_NMRG"'
      CurrentIGNO=1268
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      ENTRY=C00250(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(247),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "EXPPRICE_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01291')
      RETURN
      END
      SUBROUTINE S01292(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "px_ir"'
      CurrentAction2=
     *  ' in equation "EXPPRICE_NMRG"'
      CurrentIGNO=1268
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      252)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00002-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(252),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(247),COLBF(252),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "px_ir"',
     *  ' in equation "EXPPRICE_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01292')
      RETURN
      END
      SUBROUTINE S01293(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00252(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "IMPPRICE1_MARG"'
      CurrentIGNO=1274
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,s,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=-C00252(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(248),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "IMPPRICE1_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01293')
      RETURN
      END
      SUBROUTINE S01294(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00252(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "IMPPRICE1_MARG"'
      CurrentIGNO=1274
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=C00252(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(248),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "IMPPRICE1_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01294')
      RETURN
      END
      SUBROUTINE S01295(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00252(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "IMPPRICE1_MARG"'
      CurrentIGNO=1274
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=C00252(SSMP(SSMPST(1)-1+I00005),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(248),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "IMPPRICE1_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01295')
      RETURN
      END
      SUBROUTINE S01297(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm_ir"'
      CurrentAction2=
     *  ' in equation "IMPPRICE1_MARG"'
      CurrentIGNO=1274
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      253)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      RWN=I00005+SSZ(3)*(I00003-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(1)-1+I00005)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(253),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(248),COLBF(253),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm_ir"',
     *  ' in equation "IMPPRICE1_MARG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01297')
      RETURN
      END
      SUBROUTINE S01298(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00252(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm"'
      CurrentAction2=
     *  ' in equation "IMPPRICE1_NMRG"'
      CurrentIGNO=1275
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=-C00252(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(2)-1+
     *  I00001)))+SSZ(9)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(5),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(249),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm"',
     *  ' in equation "IMPPRICE1_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01298')
      RETURN
      END
      SUBROUTINE S01299(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00252(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "tx"'
      CurrentAction2=
     *  ' in equation "IMPPRICE1_NMRG"'
      CurrentIGNO=1275
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      106)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=C00252(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(106),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(249),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(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "tx"',
     *  ' in equation "IMPPRICE1_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01299')
      RETURN
      END
      SUBROUTINE S01300(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00252(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "txs"'
      CurrentAction2=
     *  ' in equation "IMPPRICE1_NMRG"'
      CurrentIGNO=1275
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      107)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00003-1)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      ENTRY=C00252(SSMP(SSMPST(2)-1+I00001),I00002,I00003)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00002-1+SSZ(1)*(I00003-
     *  1))
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(107),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
    3 CONTINUE
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(249),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
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "txs"',
     *  ' in equation "IMPPRICE1_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01300')
      RETURN
      END
      SUBROUTINE S01301(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "pm_ir"'
      CurrentAction2=
     *  ' in equation "IMPPRICE1_NMRG"'
      CurrentIGNO=1275
      CurrentIGTP='sm'
      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') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      253)
      DO 1 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00001=1,SSZ(4)  ! (all,i,NMRG_COMM)
      RWN=I00001+SSZ(4)*(I00003-1)
      ENTRY=1.0
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=SSMP(SSMPST(2)-1+I00001)+SSZ(2)*(I00003-1)
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(253),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(249),COLBF(253),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "pm_ir"',
     *  ' in equation "IMPPRICE1_NMRG"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01301')
      RETURN
      END
      SUBROUTINE S01306(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00245,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00245(SSZ(2),SSZ(1))
      REAL C00249(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "px_i"'
      CurrentAction2=
     *  ' in equation "c1_irEQ"'
      CurrentIGNO=1287
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "px_i"',
     *  ' in equation "c1_irEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      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(      254)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=-(C00245(I00001,I00002)-C00249(I00001,I00002))
      IF(KZC.OR.ENTRY.NE.0.0) THEN
        COLUMN=I00001
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(254),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(252),COLBF(254),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "px_i"',
     *  ' in equation "c1_irEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01306')
      RETURN
      END
      SUBROUTINE S01307(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,NEEDSM,KZC,DOEQ,STRHS,STRHNZ,
     *  C00245,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
      USE ARITHERROR
      INTEGER EWKUN
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      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
      LOGICAL LGX
      CHARACTER NEEDSM
      INTEGER MinMMNZ,EQROW(MinMMNZ),EQCOL(MinMMNZ)
      REAL EQCOEF(MinMMNZ)
      INTEGER NUMEQ,ROWBF(NUMEQ),COLBF(NUMVC)
      INTEGER SMNZ,EQNZ,KSTEP,STRHNZ
      LOGICAL KZC,DOEQ,USEIT,STRHS
      LOGICAL ECHO1
      REAL C00245(SSZ(2),SSZ(1))
      REAL C00249(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'submatrix for variable "px_"'
      CurrentAction2=
     *  ' in equation "c1_irEQ"'
      CurrentIGNO=1287
      CurrentIGTP='sm'
      CALL GPAPRW(
     *  ' before calculating submatrix for variable "px_"',
     *  ' in equation "c1_irEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(NEEDSM.EQ.'n') GOTO 9000
      SMNZ=0
      N3=0
      IF(.NOT.FMRHSC) USEIT=.TRUE.
      IF(.NOT.DOEQ) GOTO 9000
      IF(ECHO1) THEN
        CALL GPTO1('    Submatrix for variable ''%t''',
     *    'px_',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      RWN=0
      NZ=0
      NCL=NCP(      255)
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RWN=I00001+SSZ(2)*(I00002-1)
      ENTRY=C00245(I00001,I00002)-C00249(I00001,I00002)
      IF(KZC.OR.ENTRY.NE.0.0) THEN
      COLUMN=1
        IF(FMRHSC) USEIT=SHENV(COLUMN+COLBF(255),1).NE.'x'
        IF(USEIT) THEN
         NZ=NZ+1
         ENT(NZ)=ENTRY
         ICN(NZ)=COLUMN
        END IF ! IF(USEIT) THEN
      END IF ! (KZC.OR.ENTRY.NE.0.0)
      CALL TGANZ2(MCO,NZ,RWN,ENT,ICN,MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  ROWBF(252),COLBF(255),EQNZ,SMNZ,
     *  FMRHSC,MMNCOL,XSHOCK,XSHOC2,XSHOC3,LHSMAP,SHENV,
     *  MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,KSTEP,NMSTSL,N3,
     *  KZC,.FALSE.,EWKUN,STRHS,STRHNZ,
     *  MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
    2 CONTINUE
    1 CONTINUE
      IF(ECHO1.AND.IER.EQ.0) THEN
       IF(.NOT.FMRHSC) CALL TBECNZ(SMNZ,ERRMES)
       IF(FMRHSC) CALL TGENZ2(SMNZ,N3,ERRMES)
       IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating submatrix for variable "px_"',
     *  ' in equation "c1_irEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01307')
      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''',
     *    'CONT_EV_tech_aor',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01266(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(92),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(93),ECHO1,
     *  ROWBF(237),COLBF(93),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00302,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01268(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(94),KZC,DOEQ,STRHS,STRHNZ,
     *  C00045,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(243),ECHO1,
     *  ROWBF(237),COLBF(243),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'CONT_EV_tech_afr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(87),ECHO1,
     *  ROWBF(239),COLBF(87),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(35),SSZ(1),1,1,1,1,1,C00316,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(88),ECHO1,
     *  ROWBF(239),COLBF(88),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(7),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(89),ECHO1,
     *  ROWBF(239),COLBF(89),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),1,1,1,1,1,1,C00318,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01273(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(90),KZC,DOEQ,STRHS,STRHNZ,
     *  C00116,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(239),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''',
     *    'CONT_EV_tech_atrr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01275(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(113),KZC,DOEQ,STRHS,STRHNZ,
     *  C00352,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(114),ECHO1,
     *  ROWBF(241),COLBF(114),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00353,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(115),ECHO1,
     *  ROWBF(241),COLBF(115),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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(116),ECHO1,
     *  ROWBF(241),COLBF(116),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(1),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(247),ECHO1,
     *  ROWBF(241),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''',
     *    'CONT_EV_tech_amsr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01280(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(85),KZC,DOEQ,STRHS,STRHNZ,
     *  C00032,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(243),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''',
     *    'CONT_EV_kbr',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01282(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(28),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01283(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(44),KZC,DOEQ,STRHS,STRHNZ,
     *  C00031,C00243,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,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(245),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''',
     *    'EXPPRICE_MARG',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01285(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),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 S01286(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),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 S01287(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01288(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(252),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 S01289(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),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 S01290(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),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 S01291(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  C00250,
     *  MCO,ENT,ICN,FMRHSC,MMSBT,NSUBTO,
     *  CALCNEWTERRSUBMATRIX,NEWTERR_DIM,NEWTERR,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,MMNROW,CUMCOL,
     *  DMSTSL,NMSTSL,DIM1_MSTSOL,MSTSOL,XSHOC2,XSHOC3,
     *  MinMMNZ,EQCOEF,EQROW,EQCOL,
     *  NUMVC,NCP,EQNZ,NUMEQ,ROWBF,COLBF,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01292(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(252),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 S01293(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  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 S01294(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  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 S01295(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  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(120),ECHO1,
     *  ROWBF(248),COLBF(120),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(3),SSZ(1),1,1,1,1,1,C00253,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 S01297(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(253),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 S01298(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(5),KZC,DOEQ,STRHS,STRHNZ,
     *  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 S01299(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(106),KZC,DOEQ,STRHS,STRHNZ,
     *  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 S01300(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(107),KZC,DOEQ,STRHS,STRHNZ,
     *  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 S01301(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(253),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(252),ECHO1,
     *  ROWBF(250),COLBF(252),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00254,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(254),ECHO1,
     *  ROWBF(250),COLBF(254),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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(254),ECHO1,
     *  ROWBF(251),COLBF(254),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),1,1,1,1,1,1,C00255,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(255),ECHO1,
     *  ROWBF(251),COLBF(255),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c1_irEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01306(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(254),KZC,DOEQ,STRHS,STRHNZ,
     *  C00245,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
      CALCNEWTERRSUBMATRIX=.FALSE.
      CALL S01307(MMNSS,SSIOS,ECHO1,EWKUN,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  KSTEP,SMND(255),KZC,DOEQ,STRHS,STRHNZ,
     *  C00245,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(256),ECHO1,
     *  ROWBF(252),COLBF(256),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c2_irEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(252),ECHO1,
     *  ROWBF(253),COLBF(252),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00245,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(254),ECHO1,
     *  ROWBF(253),COLBF(254),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00245,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(257),ECHO1,
     *  ROWBF(253),COLBF(257),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c3_irEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(253),ECHO1,
     *  ROWBF(254),COLBF(253),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00249,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(254),ECHO1,
     *  ROWBF(254),COLBF(254),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  SSZ(2),SSZ(1),1,1,1,1,1,C00249,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(258),ECHO1,
     *  ROWBF(254),COLBF(258),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c1_rEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(256),ECHO1,
     *  ROWBF(255),COLBF(256),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(259),ECHO1,
     *  ROWBF(255),COLBF(259),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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 M00031(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  RWA,NUMFL,
     *  EWKUN,MINMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,
     *  KSTEP,KSTEPA,MCO,ENT,ICN,ADR,LRW,
     *  NMSTSL,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,STRHS,STRHNZ,
     *  DOEQ,NDEWK,CALCNEWTERR,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c5
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      REAL RWA(DWA)
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      INTEGER STRHNZ
      INTEGER EWKUN
      INTEGER MINMMNZ,EQROW(MINMMNZ),EQCOL(MINMMNZ),EQNZ
      REAL EQCOEF(MINMMNZ)
      INTEGER SMDUN,MXSMNZ
      LOGICAL SMWROK
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL DOEQ,NDEWK,STRHS
      LOGICAL CALCNEWTERR,CALCNEWTERRSUBMATRIX
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER KSTEP,KSTEPA,MCO,ICN(MCO),ADR(MCO),LRW(MCO)
      REAL ENT(MCO)
      INTEGER NMSTSL
      SKPSMD=.TRUE.
      LOWMEM=.FALSE.
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'c2_rEQ',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(257),ECHO1,
     *  ROWBF(256),COLBF(257),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(260),ECHO1,
     *  ROWBF(256),COLBF(260),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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(258),ECHO1,
     *  ROWBF(257),COLBF(258),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(261),ECHO1,
     *  ROWBF(257),COLBF(261),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(DOEQ.AND.ECHO1) THEN
        CALL GPTO1('\n Equation ''%t''',
     *    'TOT2eq',0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(259),ECHO1,
     *  ROWBF(258),COLBF(259),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(260),ECHO1,
     *  ROWBF(258),COLBF(260),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(261),ECHO1,
     *  ROWBF(258),COLBF(261),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  MMNCOL,SHENV,LHSMAP,XSHOCK,XSHOC2,XSHOC3,
     *  STRHS,STRHNZ,MMSBT,NSUBTO,
     *    .FALSE.,NEWTERR_DIM,NEWTERR,0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGCSM2('tg',DOEQ,AXSUN,MMNST,SSZ,NUMVC,NCP,
     *  CWKUN,1,1,KSTEPA,SMND(262),ECHO1,
     *  ROWBF(258),COLBF(262),SKPSMD,LOWMEM,MXSMNZ,SMWROK,
     *  SMDUN,EWKUN,MinMMNZ,EQCOEF,EQROW,EQCOL,EQNZ,MMI,MMR,
     *  1,1,1,1,1,1,1,RWA,
     *  KZC,NDEWK,.FALSE.,0,
     *  .NOT.FMRHSC,MMNROW,CUMCOL,DIM1_MSTSOL,DMSTSL,MSTSOL,NMSTSL,
     *  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('M00031')
      RETURN
      END
      SUBROUTINE S01325(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00032,C00243,
     *  V00085,V00250,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00085(SSZ(2),SSZ(1),SSZ(1))
      REAL V00250(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTtech_amsirs"'
      CurrentAction2=
     *  ' using equation "CONT_EV_tech_amsirs"'
      CurrentIGNO=1244
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTtech_amsirs"',
     *  ' using equation "CONT_EV_tech_amsirs"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00250(I00001,I00002,I00003)=0.01  *C00243(I00002)*
     *  C00032(I00001,I00002,I00003)*V00085(I00001,I00002,I00003)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTtech_amsirs"',
     *  ' using equation "CONT_EV_tech_amsirs"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00162,C00243,
     *  V00113,V00114,V00115,V00116,V00248,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00113(SSZ(2))
      REAL V00114(SSZ(2))
      REAL V00115(SSZ(1))
      REAL V00116(SSZ(1))
      REAL V00248(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTtech_afmfdsd"'
      CurrentAction2=
     *  ' using equation "CONT_EV_tech_afmfdsd"'
      CurrentIGNO=1240
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTtech_afmfdsd"',
     *  ' using equation "CONT_EV_tech_afmfdsd"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      V00248(I00005,I00001,I00002,I00003)=-(-0.01  *C00243(I00003)*
     *  C00162(I00005,I00001,I00002,I00003)*V00113(SSMP(SSMPST(1)-1+
     *  I00005))-0.01  *C00243(I00003)*
     *  C00162(I00005,I00001,I00002,I00003)*V00114(I00001)-0.01  *
     *  C00243(I00003)*C00162(I00005,I00001,I00002,I00003)*
     *  V00115(I00002)-0.01  *C00243(I00003)*
     *  C00162(I00005,I00001,I00002,I00003)*V00116(I00003))
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    3 CONTINUE  ! END (all,r,REG)
    4 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTtech_afmfdsd"',
     *  ' using equation "CONT_EV_tech_afmfdsd"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00116,C00243,
     *  V00087,V00088,V00089,V00090,V00246,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00116(SSZ(35),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00087(SSZ(35))
      REAL V00088(SSZ(7))
      REAL V00089(SSZ(1))
      REAL V00090(SSZ(35),SSZ(7),SSZ(1))
      REAL V00246(SSZ(35),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTtech_afijr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_tech_afijr"'
      CurrentIGNO=1236
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTtech_afijr"',
     *  ' using equation "CONT_EV_tech_afijr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(35)  ! (all,i,FIRM_COMM)
      V00246(I00001,I00004,I00002)=-(-0.01  *C00243(I00002)*
     *  C00116(I00001,I00004,I00002)*V00087(I00001)-0.01  *
     *  C00243(I00002)*C00116(I00001,I00004,I00002)*V00088(I00004)-
     *  0.01  *C00243(I00002)*C00116(I00001,I00004,I00002)*
     *  V00089(I00002)-0.01  *C00243(I00002)*
     *  C00116(I00001,I00004,I00002)*V00090(I00001,I00004,I00002))
    1 CONTINUE  ! END (all,i,FIRM_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTtech_afijr"',
     *  ' using equation "CONT_EV_tech_afijr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00045,C00243,
     *  V00092,V00093,V00094,V00244,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00045(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00092(SSZ(7))
      REAL V00093(SSZ(1))
      REAL V00094(SSZ(7),SSZ(1))
      REAL V00244(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTtech_aoir"'
      CurrentAction2=
     *  ' using equation "CONT_EV_tech_aoir"'
      CurrentIGNO=1232
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTtech_aoir"',
     *  ' using equation "CONT_EV_tech_aoir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      V00244(I00001,I00002)=-(-0.01  *C00243(I00002)*
     *  C00045(SSMP(SSMPST(9)-1+I00001),I00002)*V00092(I00001)-0.01  *
     *  C00243(I00002)*C00045(SSMP(SSMPST(9)-1+I00001),I00002)*
     *  V00093(I00002)-0.01  *C00243(I00002)*C00045(SSMP(SSMPST(9)-1+
     *  I00001),I00002)*V00094(I00001,I00002))
    1 CONTINUE  ! END (all,i,PROD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTtech_aoir"',
     *  ' using equation "CONT_EV_tech_aoir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00034,C00036,C00243,C00244,C00335,C00336,C00337,
     *  V00005,V00106,V00107,V00120,V00172,V00238,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10,RS11,RS12
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL C00036(SSZ(3),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00244(SSZ(3),SSZ(1))
      REAL C00335(SSZ(2),SSZ(1))
      REAL C00336(SSZ(2),SSZ(1))
      REAL C00337(SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00106(SSZ(2),SSZ(1))
      REAL V00107(SSZ(2),SSZ(1),SSZ(1))
      REAL V00120(SSZ(3))
      REAL V00172(1)
      REAL V00238(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTtotr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_totr"'
      CurrentIGNO=1220
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTtotr"',
     *  ' using equation "CONT_EV_totr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00335(I00001,I00002)*V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS2=0.0
      DO 3 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS2=RS2-0.01  *C00243(I00002)*C00036(I00005,I00002)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005))),I00002)
    3 CONTINUE  ! END SUM(m,MARG_COMM
      RS3=0.0
      DO 5 I00003=1,SSZ(1)  ! SUM(s,REG
      RS4=0.0
      DO 4 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS4=RS4+0.01  *C00243(I00002)*C00034(I00001,I00003,I00002)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00003)
    4 CONTINUE  ! END SUM(i,TRAD_COMM
      RS3=RS3+RS4
    5 CONTINUE  ! END SUM(s,REG
      RS5=0.0
      DO 6 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS5=RS5+C00336(I00001,I00002)*V00106(I00001,I00002)
    6 CONTINUE  ! END SUM(i,TRAD_COMM
      RS6=0.0
      DO 8 I00003=1,SSZ(1)  ! SUM(s,REG
      RS7=0.0
      DO 7 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS7=RS7-0.01  *C00243(I00002)*C00034(I00001,I00003,I00002)*
     *  V00106(I00001,I00003)
    7 CONTINUE  ! END SUM(i,TRAD_COMM
      RS6=RS6+RS7
    8 CONTINUE  ! END SUM(s,REG
      RS8=0.0
      DO 10 I00003=1,SSZ(1)  ! SUM(s,REG
      RS9=0.0
      DO 9 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS9=RS9+0.01  *C00243(I00002)*C00034(I00001,I00002,I00003)*
     *  V00107(I00001,I00002,I00003)
    9 CONTINUE  ! END SUM(i,TRAD_COMM
      RS8=RS8+RS9
   10 CONTINUE  ! END SUM(s,REG
      RS10=0.0
      DO 12 I00003=1,SSZ(1)  ! SUM(s,REG
      RS11=0.0
      DO 11 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS11=RS11-0.01  *C00243(I00002)*C00034(I00001,I00003,I00002)*
     *  V00107(I00001,I00003,I00002)
   11 CONTINUE  ! END SUM(i,TRAD_COMM
      RS10=RS10+RS11
   12 CONTINUE  ! END SUM(s,REG
      RS12=0.0
      DO 13 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS12=RS12+0.01  *C00243(I00002)*C00244(I00005,I00002)*
     *  V00120(I00005)
   13 CONTINUE  ! END SUM(m,MARG_COMM
      V00238(I00002)=-(RS1+RS2+RS3+RS5+RS6+RS8+RS10+RS12+C00337(I00002)*
     *  V00172(1))
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTtotr"',
     *  ' using equation "CONT_EV_totr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00008,C00053,C00054,C00055,C00056,C00058,C00059,C00060,
     *  C00061,C00063,C00064,C00065,C00066,C00068,C00070,C00072,
     *  C00074,C00076,C00086,C00088,C00090,C00100,C00102,C00104,
     *  C00119,C00121,C00123,C00243,C00262,C00291,C00292,C00293,
     *  V00004,V00005,V00006,V00009,V00010,V00012,V00013,V00016,
     *  V00018,V00022,V00023,V00026,V00031,V00041,V00044,V00070,
     *  V00074,V00083,V00236,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00262(SSZ(1))
      REAL C00291(SSZ(2),SSZ(1))
      REAL C00292(SSZ(2),SSZ(1))
      REAL C00293(SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00006(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00010(SSZ(2),SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL V00013(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL V00018(SSZ(9),SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL V00023(SSZ(2),SSZ(7),SSZ(1))
      REAL V00026(SSZ(2),SSZ(7),SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00044(SSZ(1))
      REAL V00070(SSZ(19),SSZ(1))
      REAL V00074(SSZ(27),SSZ(1))
      REAL V00083(SSZ(35),SSZ(7),SSZ(1))
      REAL V00236(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTalleffr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_alleffr"'
      CurrentIGNO=1215
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTalleffr"',
     *  ' using equation "CONT_EV_alleffr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-0.01  *C00243(I00002)*(C00063(I00001,I00002)+
     *  C00064(I00001,I00002))*V00004(I00001,I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00291(I00001,I00002)*V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS3=0.0
      DO 4 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS3=RS3-0.01  *C00243(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*C00076(I00001)*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)*
     *  V00006(I00001,I00002)
    4 CONTINUE  ! END SUM(i,TRAD_COMM
      RS4=0.0
      DO 5 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS4=RS4+C00292(I00001,I00002)*V00009(I00001,I00002)
    5 CONTINUE  ! END SUM(i,TRAD_COMM
      RS5=0.0
      DO 6 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS5=RS5+0.01  *C00243(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*(C00076(I00001)*C00088(I00001,I00002)-
     *  C00076(I00001)*C00090(I00001,I00002)*C00088(I00001,I00002))*
     *  V00010(I00001,I00002)
    6 CONTINUE  ! END SUM(i,TRAD_COMM
      RS6=0.0
      DO 7 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS6=RS6-0.01  *C00243(I00002)*(C00058(I00001,I00002)+
     *  C00059(I00001,I00002))*V00012(I00001,I00002)
    7 CONTINUE  ! END SUM(i,TRAD_COMM
      RS7=0.0
      DO 8 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS7=RS7-0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*(1  -
     *  C00104(I00001,I00002))*C00100(I00001,I00002)*
     *  V00013(I00001,I00002)
    8 CONTINUE  ! END SUM(i,TRAD_COMM
      RS8=0.0
      DO 9 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS8=RS8+(0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*C00102(I00001,I00002)-
     *  0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*C00076(I00001)*C00104(I00001,I00002)*
     *  C00102(I00001,I00002))*V00016(I00001,I00002)
    9 CONTINUE  ! END SUM(i,TRAD_COMM
      RS9=0.0
      DO 10 I00001=1,SSZ(9)  ! SUM(i,NSAV_COMM
      RS9=RS9-0.01  *C00243(I00002)*C00070(I00001,I00002)*
     *  V00018(I00001,I00002)
   10 CONTINUE  ! END SUM(i,NSAV_COMM
      RS10=0.0
      DO 12 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS11=0.0
      DO 11 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS11=RS11-0.01  *C00243(I00002)*(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))*V00022(I00001,I00004,I00002)
   11 CONTINUE  ! END SUM(i,TRAD_COMM
      RS10=RS10+RS11
   12 CONTINUE  ! END SUM(j,PROD_COMM
      RS12=0.0
      DO 14 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS13=0.0
      DO 13 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS13=RS13-0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*C00076(I00001)*(1  -
     *  C00123(I00001,I00004,I00002))*C00119(I00001,I00004,I00002)*
     *  V00023(I00001,I00004,I00002)
   13 CONTINUE  ! END SUM(i,TRAD_COMM
      RS12=RS12+RS13
   14 CONTINUE  ! END SUM(j,PROD_COMM
      RS14=0.0
      DO 16 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS15=0.0
      DO 15 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS15=RS15+0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*(C00076(I00001)*
     *  C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002))*
     *  V00026(I00001,I00004,I00002)
   15 CONTINUE  ! END SUM(i,TRAD_COMM
      RS14=RS14+RS15
   16 CONTINUE  ! END SUM(j,PROD_COMM
      RS16=0.0
      DO 18 I00003=1,SSZ(1)  ! SUM(s,REG
      RS17=0.0
      DO 17 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS17=RS17-0.01  *C00243(I00002)*C00072(I00001,I00002,I00003)*
     *  V00031(I00001,I00002,I00003)
   17 CONTINUE  ! END SUM(i,TRAD_COMM
      RS16=RS16+RS17
   18 CONTINUE  ! END SUM(s,REG
      RS18=0.0
      DO 20 I00003=1,SSZ(1)  ! SUM(s,REG
      RS19=0.0
      DO 19 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS19=RS19-0.01  *C00243(I00002)*C00074(I00001,I00003,I00002)*
     *  V00031(I00001,I00003,I00002)
   19 CONTINUE  ! END SUM(i,TRAD_COMM
      RS18=RS18+RS19
   20 CONTINUE  ! END SUM(s,REG
      RS20=0.0
      DO 21 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS20=RS20-0.01  *C00243(I00002)*(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*V00070(SSMP(SSMPST(17)-1+I00001),I00002)
   21 CONTINUE  ! END SUM(i,TRAD_COMM
      RS21=0.0
      DO 22 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS21=RS21-0.01  *C00243(I00002)*(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*V00074(SSMP(SSMPST(26)-1+I00001),I00002)
   22 CONTINUE  ! END SUM(i,TRAD_COMM
      RS22=0.0
      DO 24 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS23=0.0
      DO 23 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      RS23=RS23-0.01  *C00243(I00002)*C00068(I00001,I00004,I00002)*
     *  V00083(SSMP(SSMPST(35)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00004,I00002)
   23 CONTINUE  ! END SUM(i,ENDW_COMM
      RS22=RS22+RS23
   24 CONTINUE  ! END SUM(j,PROD_COMM
      RS24=0.0
      DO 26 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS25=0.0
      DO 25 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS25=RS25-0.01  *C00243(I00002)*(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*V00083(SSMP(SSMPST(35)-1+
     *  SSMP(SSMPST(6)-1+I00001)),I00004,I00002)
   25 CONTINUE  ! END SUM(i,TRAD_COMM
      RS24=RS24+RS25
   26 CONTINUE  ! END SUM(j,PROD_COMM
      V00236(I00002)=-(RS1+RS2+RS3+RS4+RS5+RS6+RS7+RS8+RS9+RS10+RS12+
     *  RS14+RS16+RS18+C00293(I00002)*V00041(C00008(I00002))+
     *  C00262(I00002)*V00044(I00002)+RS20+RS21+RS22+RS24)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTalleffr"',
     *  ' using equation "CONT_EV_alleffr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01330')
      RETURN
      END
      SUBROUTINE S01331(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00074,C00243,
     *  V00031,V00044,V00235,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00235(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqimisr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qimisr"'
      CurrentIGNO=1213
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqimisr"',
     *  ' using equation "CONT_EV_qimisr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00235(I00001,I00003,I00002)=C00074(I00001,I00003,I00002)*0.01  *
     *  C00243(I00002)*(V00031(I00001,I00003,I00002)-V00044(I00002))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqimisr"',
     *  ' using equation "CONT_EV_qimisr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01331')
      RETURN
      END
      SUBROUTINE S01332(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00074,C00243,
     *  V00031,V00044,V00234,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00074(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00234(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqimr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qimr"'
      CurrentIGNO=1211
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqimr"',
     *  ' using equation "CONT_EV_qimr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00074(I00001,I00003,I00002)*0.01  *C00243(I00002)*
     *  (V00031(I00001,I00003,I00002)-V00044(I00002))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(s,REG
      V00234(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqimr"',
     *  ' using equation "CONT_EV_qimr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00072,C00243,
     *  V00031,V00044,V00233,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00233(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqxsirs"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qxsirs"'
      CurrentIGNO=1209
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqxsirs"',
     *  ' using equation "CONT_EV_qxsirs"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00233(I00001,I00002,I00003)=C00072(I00001,I00002,I00003)*0.01  *
     *  C00243(I00002)*(V00031(I00001,I00002,I00003)-V00044(I00002))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqxsirs"',
     *  ' using equation "CONT_EV_qxsirs"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00072,C00243,
     *  V00031,V00044,V00232,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00072(SSZ(2),SSZ(1),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00232(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqxsr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qxsr"'
      CurrentIGNO=1207
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqxsr"',
     *  ' using equation "CONT_EV_qxsr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00003=1,SSZ(1)  ! SUM(s,REG
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00072(I00001,I00002,I00003)*0.01  *C00243(I00002)*
     *  (V00031(I00001,I00002,I00003)-V00044(I00002))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(s,REG
      V00232(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqxsr"',
     *  ' using equation "CONT_EV_qxsr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01334')
      RETURN
      END
      SUBROUTINE S01335(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00063,C00064,C00243,
     *  V00004,V00044,V00231,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00231(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqgdir"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qgdir"'
      CurrentIGNO=1205
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqgdir"',
     *  ' using equation "CONT_EV_qgdir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00231(I00001,I00002)=(C00063(I00001,I00002)+
     *  C00064(I00001,I00002))*0.01  *C00243(I00002)*
     *  (V00004(I00001,I00002)-V00044(I00002))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqgdir"',
     *  ' using equation "CONT_EV_qgdir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01335')
      RETURN
      END
      SUBROUTINE S01336(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00063,C00064,C00243,
     *  V00004,V00044,V00230,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00063(SSZ(2),SSZ(1))
      REAL C00064(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00230(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqgdr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qgdr"'
      CurrentIGNO=1203
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqgdr"',
     *  ' using equation "CONT_EV_qgdr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+(C00063(I00001,I00002)+C00064(I00001,I00002))*0.01  *
     *  C00243(I00002)*(V00004(I00001,I00002)-V00044(I00002))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      V00230(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqgdr"',
     *  ' using equation "CONT_EV_qgdr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01336')
      RETURN
      END
      SUBROUTINE S01337(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00065,C00066,C00076,C00086,C00087,C00088,C00089,
     *  C00090,C00243,
     *  V00005,V00006,V00009,V00010,V00041,V00044,V00070,V00229,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00006(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00010(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00044(SSZ(1))
      REAL V00070(SSZ(19),SSZ(1))
      REAL V00229(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqgmir"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qgmir"'
      CurrentIGNO=1201
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqgmir"',
     *  ' using equation "CONT_EV_qgmir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=-(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002)*V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)-(C00065(I00001,I00002)+C00066(I00001,I00002))*
     *  0.01  *C00243(I00002)*C00076(I00001)*(1  -
     *  C00090(I00001,I00002))*C00086(I00001,I00002)*
     *  V00006(I00001,I00002)
      RS2=RS1+(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00243(I00002)*(C00076(I00001)*C00088(I00001,I00002)-
     *  C00076(I00001)*C00090(I00001,I00002)*C00088(I00001,I00002))*
     *  V00009(I00001,I00002)+(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*0.01  *C00243(I00002)*(C00076(I00001)*
     *  C00088(I00001,I00002)-C00076(I00001)*C00090(I00001,I00002)*
     *  C00088(I00001,I00002))*V00010(I00001,I00002)
      RS3=RS2+(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00243(I00002)*(C00076(I00001)*100.0 *C00089(I00001,I00002)+
     *  C00076(I00001)*(-C00090(I00001,I00002)*100.0 *
     *  C00089(I00001,I00002)-(1  -C00090(I00001,I00002))*100.0 *
     *  C00087(I00001,I00002)))*V00041(C00008(I00002))+
     *  (C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00243(I00002)*V00044(I00002)
      V00229(I00001,I00002)=-(RS3-(C00065(I00001,I00002)+
     *  C00066(I00001,I00002))*0.01  *C00243(I00002)*
     *  V00070(SSMP(SSMPST(17)-1+I00001),I00002))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqgmir"',
     *  ' using equation "CONT_EV_qgmir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01337')
      RETURN
      END
      SUBROUTINE S01338(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00065,C00066,C00076,C00086,C00088,C00090,C00243,
     *  C00260,C00261,
     *  V00005,V00006,V00009,V00010,V00041,V00044,V00070,V00228,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00065(SSZ(2),SSZ(1))
      REAL C00066(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00260(SSZ(1))
      REAL C00261(SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00006(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00010(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00044(SSZ(1))
      REAL V00070(SSZ(19),SSZ(1))
      REAL V00228(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqgmr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qgmr"'
      CurrentIGNO=1199
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqgmr"',
     *  ' using equation "CONT_EV_qgmr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002)*V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2-(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*(1  -C00090(I00001,I00002))*
     *  C00086(I00001,I00002)*V00006(I00001,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS3=0.0
      DO 4 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS3=RS3+(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00243(I00002)*(C00076(I00001)*C00088(I00001,I00002)-
     *  C00076(I00001)*C00090(I00001,I00002)*C00088(I00001,I00002))*
     *  V00009(I00001,I00002)
    4 CONTINUE  ! END SUM(i,TRAD_COMM
      RS4=0.0
      DO 5 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS4=RS4+(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00243(I00002)*(C00076(I00001)*C00088(I00001,I00002)-
     *  C00076(I00001)*C00090(I00001,I00002)*C00088(I00001,I00002))*
     *  V00010(I00001,I00002)
    5 CONTINUE  ! END SUM(i,TRAD_COMM
      RS5=0.0
      DO 6 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS5=RS5-(C00065(I00001,I00002)+C00066(I00001,I00002))*0.01  *
     *  C00243(I00002)*V00070(SSMP(SSMPST(17)-1+I00001),I00002)
    6 CONTINUE  ! END SUM(i,TRAD_COMM
      V00228(I00002)=-(RS1+RS2+RS3+RS4+C00260(I00002)*
     *  V00041(C00008(I00002))+C00261(I00002)*V00044(I00002)+RS5)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqgmr"',
     *  ' using equation "CONT_EV_qgmr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01338')
      RETURN
      END
      SUBROUTINE S01339(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00058,C00059,C00243,
     *  V00012,V00044,V00227,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00227(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqpdir"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qpdir"'
      CurrentIGNO=1197
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqpdir"',
     *  ' using equation "CONT_EV_qpdir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00227(I00001,I00002)=(C00058(I00001,I00002)+
     *  C00059(I00001,I00002))*0.01  *C00243(I00002)*
     *  (V00012(I00001,I00002)-V00044(I00002))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqpdir"',
     *  ' using equation "CONT_EV_qpdir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01339')
      RETURN
      END
      SUBROUTINE S01340(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00058,C00059,C00243,
     *  V00012,V00044,V00226,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00058(SSZ(2),SSZ(1))
      REAL C00059(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00226(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqpdr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qpdr"'
      CurrentIGNO=1195
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqpdr"',
     *  ' using equation "CONT_EV_qpdr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+(C00058(I00001,I00002)+C00059(I00001,I00002))*0.01  *
     *  C00243(I00002)*(V00012(I00001,I00002)-V00044(I00002))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      V00226(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqpdr"',
     *  ' using equation "CONT_EV_qpdr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01340')
      RETURN
      END
      SUBROUTINE S01341(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00060,C00061,C00076,C00100,C00101,C00102,C00103,
     *  C00104,C00243,
     *  V00005,V00009,V00013,V00016,V00041,V00044,V00074,V00225,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00013(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00044(SSZ(1))
      REAL V00074(SSZ(27),SSZ(1))
      REAL V00225(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqpmir"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qpmir"'
      CurrentIGNO=1193
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqpmir"',
     *  ' using equation "CONT_EV_qpmir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=((C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*C00102(I00001,I00002)-
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*C00104(I00001,I00002)*
     *  C00102(I00001,I00002))*V00009(I00001,I00002)
      RS2=-(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*(1  -C00104(I00001,I00002))*
     *  C00100(I00001,I00002)*V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)+RS1-(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*0.01  *C00243(I00002)*C00076(I00001)*
     *  (1  -C00104(I00001,I00002))*C00100(I00001,I00002)*
     *  V00013(I00001,I00002)
      RS3=((C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*100.0 *C00103(I00001,I00002)+
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*(-C00104(I00001,I00002)*100.0 *
     *  C00103(I00001,I00002)-(1  -C00104(I00001,I00002))*100.0 *
     *  C00101(I00001,I00002)))*V00041(C00008(I00002))
      RS4=RS2+((C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*C00102(I00001,I00002)-
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*C00104(I00001,I00002)*
     *  C00102(I00001,I00002))*V00016(I00001,I00002)+RS3+
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*V00044(I00002)
      V00225(I00001,I00002)=-(RS4-(C00060(I00001,I00002)+
     *  C00061(I00001,I00002))*0.01  *C00243(I00002)*
     *  V00074(SSMP(SSMPST(26)-1+I00001),I00002))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqpmir"',
     *  ' using equation "CONT_EV_qpmir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01341')
      RETURN
      END
      SUBROUTINE S01342(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00060,C00061,C00076,C00100,C00102,C00104,C00243,
     *  C00267,C00271,
     *  V00005,V00009,V00013,V00016,V00041,V00044,V00074,V00224,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00060(SSZ(2),SSZ(1))
      REAL C00061(SSZ(2),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00267(SSZ(1))
      REAL C00271(SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00013(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00044(SSZ(1))
      REAL V00074(SSZ(27),SSZ(1))
      REAL V00224(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqpmr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qpmr"'
      CurrentIGNO=1191
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqpmr"',
     *  ' using equation "CONT_EV_qpmr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1-(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*(1  -C00104(I00001,I00002))*
     *  C00100(I00001,I00002)*V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+((C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*C00102(I00001,I00002)-
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*C00104(I00001,I00002)*
     *  C00102(I00001,I00002))*V00009(I00001,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS3=0.0
      DO 4 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS3=RS3-(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*(1  -C00104(I00001,I00002))*
     *  C00100(I00001,I00002)*V00013(I00001,I00002)
    4 CONTINUE  ! END SUM(i,TRAD_COMM
      RS4=0.0
      DO 5 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS4=RS4+((C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*C00102(I00001,I00002)-
     *  (C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*C00076(I00001)*C00104(I00001,I00002)*
     *  C00102(I00001,I00002))*V00016(I00001,I00002)
    5 CONTINUE  ! END SUM(i,TRAD_COMM
      RS5=0.0
      DO 6 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS5=RS5-(C00060(I00001,I00002)+C00061(I00001,I00002))*0.01  *
     *  C00243(I00002)*V00074(SSMP(SSMPST(26)-1+I00001),I00002)
    6 CONTINUE  ! END SUM(i,TRAD_COMM
      V00224(I00002)=-(RS1+RS2+RS3+RS4+C00271(I00002)*
     *  V00041(C00008(I00002))+C00267(I00002)*V00044(I00002)+RS5)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqpmr"',
     *  ' using equation "CONT_EV_qpmr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01342')
      RETURN
      END
      SUBROUTINE S01343(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00053,C00054,C00243,
     *  V00022,V00044,V00223,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00223(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqfdijr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qfdijr"'
      CurrentIGNO=1189
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfdijr"',
     *  ' using equation "CONT_EV_qfdijr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00223(I00001,I00004,I00002)=(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  (V00022(I00001,I00004,I00002)-V00044(I00002))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqfdijr"',
     *  ' using equation "CONT_EV_qfdijr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01343')
      RETURN
      END
      SUBROUTINE S01344(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00053,C00054,C00243,
     *  V00022,V00044,V00222,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00222(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqfdir"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qfdir"'
      CurrentIGNO=1187
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfdir"',
     *  ' using equation "CONT_EV_qfdir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1+(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  (V00022(I00001,I00004,I00002)-V00044(I00002))
    3 CONTINUE  ! END SUM(j,PROD_COMM
      V00222(I00001,I00002)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqfdir"',
     *  ' using equation "CONT_EV_qfdir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01344')
      RETURN
      END
      SUBROUTINE S01345(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00053,C00054,C00243,
     *  V00022,V00044,V00221,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00053(SSZ(2),SSZ(7),SSZ(1))
      REAL C00054(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00221(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqfdr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qfdr"'
      CurrentIGNO=1185
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfdr"',
     *  ' using equation "CONT_EV_qfdr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+(C00053(I00001,I00004,I00002)+
     *  C00054(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  (V00022(I00001,I00004,I00002)-V00044(I00002))
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(j,PROD_COMM
      V00221(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqfdr"',
     *  ' using equation "CONT_EV_qfdr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01345')
      RETURN
      END
      SUBROUTINE S01346(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00055,C00056,C00076,C00119,C00120,C00121,C00122,
     *  C00123,C00243,
     *  V00005,V00009,V00023,V00026,V00041,V00044,V00083,V00220,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00023(SSZ(2),SSZ(7),SSZ(1))
      REAL V00026(SSZ(2),SSZ(7),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00044(SSZ(1))
      REAL V00083(SSZ(35),SSZ(7),SSZ(1))
      REAL V00220(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqfmijr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qfmijr"'
      CurrentIGNO=1183
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfmijr"',
     *  ' using equation "CONT_EV_qfmijr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=(C00055(I00001,I00004,I00002)+C00056(I00001,I00004,I00002))*
     *  0.01  *C00243(I00002)*(C00076(I00001)*
     *  C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002))*
     *  V00009(I00001,I00002)
      RS2=-(C00055(I00001,I00004,I00002)+C00056(I00001,I00004,I00002))*
     *  0.01  *C00243(I00002)*C00076(I00001)*(1  -
     *  C00123(I00001,I00004,I00002))*C00119(I00001,I00004,I00002)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+RS1-
     *  (C00055(I00001,I00004,I00002)+C00056(I00001,I00004,I00002))*
     *  0.01  *C00243(I00002)*C00076(I00001)*(1  -
     *  C00123(I00001,I00004,I00002))*C00119(I00001,I00004,I00002)*
     *  V00023(I00001,I00004,I00002)
      RS3=(C00055(I00001,I00004,I00002)+C00056(I00001,I00004,I00002))*
     *  0.01  *C00243(I00002)*(C00076(I00001)*100.0 *
     *  C00122(I00001,I00004,I00002)+C00076(I00001)*(-
     *  C00123(I00001,I00004,I00002)*100.0 *
     *  C00122(I00001,I00004,I00002)-(1  -C00123(I00001,I00004,I00002))*
     *  100.0 *C00120(I00001,I00004,I00002)))*V00041(C00008(I00002))
      RS4=RS2+(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  (C00076(I00001)*C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002))*
     *  V00026(I00001,I00004,I00002)+RS3+(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  V00044(I00002)
      V00220(I00001,I00004,I00002)=-(RS4-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  V00083(SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+
     *  I00001)),I00004,I00002))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqfmijr"',
     *  ' using equation "CONT_EV_qfmijr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01346')
      RETURN
      END
      SUBROUTINE S01347(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00055,C00056,C00076,C00119,C00121,C00123,C00243,
     *  C00294,C00295,C00298,C00299,
     *  V00005,V00009,V00023,V00026,V00041,V00044,V00083,V00219,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00294(SSZ(2),SSZ(1))
      REAL C00295(SSZ(2),SSZ(1))
      REAL C00298(SSZ(2),SSZ(1))
      REAL C00299(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00023(SSZ(2),SSZ(7),SSZ(1))
      REAL V00026(SSZ(2),SSZ(7),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00044(SSZ(1))
      REAL V00083(SSZ(35),SSZ(7),SSZ(1))
      REAL V00219(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqfmir"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qfmir"'
      CurrentIGNO=1181
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfmir"',
     *  ' using equation "CONT_EV_qfmir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  C00076(I00001)*(1  -C00123(I00001,I00004,I00002))*
     *  C00119(I00001,I00004,I00002)*V00023(I00001,I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      RS2=0.0
      DO 4 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=RS2+(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  (C00076(I00001)*C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002))*
     *  V00026(I00001,I00004,I00002)
    4 CONTINUE  ! END SUM(j,PROD_COMM
      RS3=0.0
      DO 5 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS3=RS3-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  V00083(SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+
     *  I00001)),I00004,I00002)
    5 CONTINUE  ! END SUM(j,PROD_COMM
      V00219(I00001,I00002)=-(C00294(I00001,I00002)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+
     *  C00295(I00001,I00002)*V00009(I00001,I00002)+RS1+RS2+
     *  C00298(I00001,I00002)*V00041(C00008(I00002))+
     *  C00299(I00001,I00002)*V00044(I00002)+RS3)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqfmir"',
     *  ' using equation "CONT_EV_qfmir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01347')
      RETURN
      END
      SUBROUTINE S01348(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00055,C00056,C00076,C00119,C00121,C00123,C00243,
     *  C00294,C00295,C00296,C00297,
     *  V00005,V00009,V00023,V00026,V00041,V00044,V00083,V00218,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00055(SSZ(2),SSZ(7),SSZ(1))
      REAL C00056(SSZ(2),SSZ(7),SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00294(SSZ(2),SSZ(1))
      REAL C00295(SSZ(2),SSZ(1))
      REAL C00296(SSZ(1))
      REAL C00297(SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00023(SSZ(2),SSZ(7),SSZ(1))
      REAL V00026(SSZ(2),SSZ(7),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00044(SSZ(1))
      REAL V00083(SSZ(35),SSZ(7),SSZ(1))
      REAL V00218(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqfmr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qfmr"'
      CurrentIGNO=1179
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfmr"',
     *  ' using equation "CONT_EV_qfmr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS1=RS1+C00294(I00001,I00002)*V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)
    2 CONTINUE  ! END SUM(i,TRAD_COMM
      RS2=0.0
      DO 3 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS2=RS2+C00295(I00001,I00002)*V00009(I00001,I00002)
    3 CONTINUE  ! END SUM(i,TRAD_COMM
      RS3=0.0
      DO 5 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS4=0.0
      DO 4 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS4=RS4-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  C00076(I00001)*(1  -C00123(I00001,I00004,I00002))*
     *  C00119(I00001,I00004,I00002)*V00023(I00001,I00004,I00002)
    4 CONTINUE  ! END SUM(i,TRAD_COMM
      RS3=RS3+RS4
    5 CONTINUE  ! END SUM(j,PROD_COMM
      RS5=0.0
      DO 7 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS6=0.0
      DO 6 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS6=RS6+(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  (C00076(I00001)*C00121(I00001,I00004,I00002)-C00076(I00001)*
     *  C00123(I00001,I00004,I00002)*C00121(I00001,I00004,I00002))*
     *  V00026(I00001,I00004,I00002)
    6 CONTINUE  ! END SUM(i,TRAD_COMM
      RS5=RS5+RS6
    7 CONTINUE  ! END SUM(j,PROD_COMM
      RS7=0.0
      DO 9 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS8=0.0
      DO 8 I00001=1,SSZ(2)  ! SUM(i,TRAD_COMM
      RS8=RS8-(C00055(I00001,I00004,I00002)+
     *  C00056(I00001,I00004,I00002))*0.01  *C00243(I00002)*
     *  V00083(SSMP(SSMPST(35)-1+SSMP(SSMPST(6)-1+
     *  I00001)),I00004,I00002)
    8 CONTINUE  ! END SUM(i,TRAD_COMM
      RS7=RS7+RS8
    9 CONTINUE  ! END SUM(j,PROD_COMM
      V00218(I00002)=-(RS1+RS2+RS3+RS5+C00296(I00002)*
     *  V00041(C00008(I00002))+C00297(I00002)*V00044(I00002)+RS7)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqfmr"',
     *  ' using equation "CONT_EV_qfmr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01348')
      RETURN
      END
      SUBROUTINE S01349(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00068,C00243,
     *  V00044,V00083,V00217,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00083(SSZ(35),SSZ(7),SSZ(1))
      REAL V00217(SSZ(6),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqfeijr"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qfeijr"'
      CurrentIGNO=1177
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfeijr"',
     *  ' using equation "CONT_EV_qfeijr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      V00217(I00001,I00004,I00002)=-(C00068(I00001,I00004,I00002)*
     *  0.01  *C00243(I00002)*V00044(I00002)-
     *  C00068(I00001,I00004,I00002)*0.01  *C00243(I00002)*
     *  V00083(SSMP(SSMPST(35)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00004,I00002))
    1 CONTINUE  ! END (all,i,ENDW_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqfeijr"',
     *  ' using equation "CONT_EV_qfeijr"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01349')
      RETURN
      END
      SUBROUTINE M00032(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  AXSUN,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 AXSUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) ERRMES
      LOGICAL FSTPAS
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTtech_amsirs','CONT_EV_tech_amsirs',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01325(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00032,C00243,
     *  V00085,V00250,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTtech_afmfdsd','CONT_EV_tech_afmfdsd',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01326(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00162,C00243,
     *  V00113,V00114,V00115,V00116,V00248,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTtech_afijr','CONT_EV_tech_afijr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01327(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00116,C00243,
     *  V00087,V00088,V00089,V00090,V00246,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTtech_aoir','CONT_EV_tech_aoir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01328(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00045,C00243,
     *  V00092,V00093,V00094,V00244,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTtotr','CONT_EV_totr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01329(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00034,C00036,C00243,C00244,C00335,C00336,C00337,
     *  V00005,V00106,V00107,V00120,V00172,V00238,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTalleffr','CONT_EV_alleffr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01330(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00053,C00054,C00055,C00056,C00058,C00059,C00060,
     *  C00061,C00063,C00064,C00065,C00066,C00068,C00070,C00072,
     *  C00074,C00076,C00086,C00088,C00090,C00100,C00102,C00104,
     *  C00119,C00121,C00123,C00243,C00262,C00291,C00292,C00293,
     *  V00004,V00005,V00006,V00009,V00010,V00012,V00013,V00016,
     *  V00018,V00022,V00023,V00026,V00031,V00041,V00044,V00070,
     *  V00074,V00083,V00236,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqimisr','CONT_EV_qimisr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01331(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00074,C00243,
     *  V00031,V00044,V00235,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqimr','CONT_EV_qimr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01332(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00074,C00243,
     *  V00031,V00044,V00234,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqxsirs','CONT_EV_qxsirs',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01333(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00072,C00243,
     *  V00031,V00044,V00233,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqxsr','CONT_EV_qxsr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01334(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00072,C00243,
     *  V00031,V00044,V00232,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqgdir','CONT_EV_qgdir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01335(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00063,C00064,C00243,
     *  V00004,V00044,V00231,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqgdr','CONT_EV_qgdr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01336(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00063,C00064,C00243,
     *  V00004,V00044,V00230,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqgmir','CONT_EV_qgmir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01337(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00065,C00066,C00076,C00086,C00087,C00088,C00089,
     *  C00090,C00243,
     *  V00005,V00006,V00009,V00010,V00041,V00044,V00070,V00229,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqgmr','CONT_EV_qgmr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01338(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00065,C00066,C00076,C00086,C00088,C00090,C00243,
     *  C00260,C00261,
     *  V00005,V00006,V00009,V00010,V00041,V00044,V00070,V00228,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqpdir','CONT_EV_qpdir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01339(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00058,C00059,C00243,
     *  V00012,V00044,V00227,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqpdr','CONT_EV_qpdr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01340(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00058,C00059,C00243,
     *  V00012,V00044,V00226,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqpmir','CONT_EV_qpmir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01341(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00060,C00061,C00076,C00100,C00101,C00102,C00103,
     *  C00104,C00243,
     *  V00005,V00009,V00013,V00016,V00041,V00044,V00074,V00225,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqpmr','CONT_EV_qpmr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01342(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00060,C00061,C00076,C00100,C00102,C00104,C00243,
     *  C00267,C00271,
     *  V00005,V00009,V00013,V00016,V00041,V00044,V00074,V00224,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfdijr','CONT_EV_qfdijr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01343(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00053,C00054,C00243,
     *  V00022,V00044,V00223,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfdir','CONT_EV_qfdir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01344(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00053,C00054,C00243,
     *  V00022,V00044,V00222,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfdr','CONT_EV_qfdr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01345(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00053,C00054,C00243,
     *  V00022,V00044,V00221,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfmijr','CONT_EV_qfmijr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01346(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00055,C00056,C00076,C00119,C00120,C00121,C00122,
     *  C00123,C00243,
     *  V00005,V00009,V00023,V00026,V00041,V00044,V00083,V00220,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfmir','CONT_EV_qfmir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01347(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00055,C00056,C00076,C00119,C00121,C00123,C00243,
     *  C00294,C00295,C00298,C00299,
     *  V00005,V00009,V00023,V00026,V00041,V00044,V00083,V00219,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfmr','CONT_EV_qfmr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01348(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00055,C00056,C00076,C00119,C00121,C00123,C00243,
     *  C00294,C00295,C00296,C00297,
     *  V00005,V00009,V00023,V00026,V00041,V00044,V00083,V00218,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfeijr','CONT_EV_qfeijr',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01349(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00068,C00243,
     *  V00044,V00083,V00217,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00032')
      RETURN
      END
      SUBROUTINE S01350(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00068,C00243,C00321,
     *  V00044,V00083,V00216,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00321(SSZ(6),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00083(SSZ(35),SSZ(7),SSZ(1))
      REAL V00216(SSZ(6),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqfeir"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qfeir"'
      CurrentIGNO=1175
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfeir"',
     *  ' using equation "CONT_EV_qfeir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS1=RS1-C00068(I00001,I00004,I00002)*0.01  *C00243(I00002)*
     *  V00083(SSMP(SSMPST(35)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00004,I00002)
    3 CONTINUE  ! END SUM(j,PROD_COMM
      V00216(I00001,I00002)=-(C00321(I00001,I00002)*V00044(I00002)+RS1)
    1 CONTINUE  ! END (all,i,ENDW_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqfeir"',
     *  ' using equation "CONT_EV_qfeir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01350')
      RETURN
      END
      SUBROUTINE S01351(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00068,C00243,C00320,
     *  V00044,V00083,V00215,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00068(SSZ(6),SSZ(7),SSZ(1))
      REAL C00243(SSZ(1))
      REAL C00320(SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00083(SSZ(35),SSZ(7),SSZ(1))
      REAL V00215(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqfer"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qfer"'
      CurrentIGNO=1173
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqfer"',
     *  ' using equation "CONT_EV_qfer"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 3 I00004=1,SSZ(7)  ! SUM(j,PROD_COMM
      RS2=0.0
      DO 2 I00001=1,SSZ(6)  ! SUM(i,ENDW_COMM
      RS2=RS2-C00068(I00001,I00004,I00002)*0.01  *C00243(I00002)*
     *  V00083(SSMP(SSMPST(35)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00004,I00002)
    2 CONTINUE  ! END SUM(i,ENDW_COMM
      RS1=RS1+RS2
    3 CONTINUE  ! END SUM(j,PROD_COMM
      V00215(I00002)=-(C00320(I00002)*V00044(I00002)+RS1)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqfer"',
     *  ' using equation "CONT_EV_qfer"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01351')
      RETURN
      END
      SUBROUTINE S01352(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00070,C00243,
     *  V00018,V00044,V00214,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00018(SSZ(9),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00214(SSZ(9),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqoir"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qoir"'
      CurrentIGNO=1171
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqoir"',
     *  ' using equation "CONT_EV_qoir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(9)  ! (all,i,NSAV_COMM)
      V00214(I00001,I00002)=C00070(I00001,I00002)*0.01  *C00243(I00002)*
     *  (V00018(I00001,I00002)-V00044(I00002))
    1 CONTINUE  ! END (all,i,NSAV_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqoir"',
     *  ' using equation "CONT_EV_qoir"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01352')
      RETURN
      END
      SUBROUTINE S01353(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00070,C00243,
     *  V00018,V00044,V00213,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00070(SSZ(9),SSZ(1))
      REAL C00243(SSZ(1))
      REAL V00018(SSZ(9),SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00213(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "CNTqor"'
      CurrentAction2=
     *  ' using equation "CONT_EV_qor"'
      CurrentIGNO=1169
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "CNTqor"',
     *  ' using equation "CONT_EV_qor"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(9)  ! SUM(i,NSAV_COMM
      RS1=RS1+0.01  *C00243(I00002)*C00070(I00001,I00002)*
     *  (V00018(I00001,I00002)-V00044(I00002))
    2 CONTINUE  ! END SUM(i,NSAV_COMM
      V00213(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "CNTqor"',
     *  ' using equation "CONT_EV_qor"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01353')
      RETURN
      END
      SUBROUTINE S01354(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00018,V00162,V00163,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00018(SSZ(9),SSZ(1))
      REAL V00162(SSZ(1))
      REAL V00163(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "compvalad"'
      CurrentAction2=
     *  ' using equation "COMPVALADEQ"'
      CurrentIGNO=985
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "compvalad"',
     *  ' using equation "COMPVALADEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(7)  ! (all,i,PROD_COMM)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      V00163(I00001,I00002)=(V00018(SSMP(SSMPST(9)-1+I00001),I00002)-
     *  V00162(I00002))
    2 CONTINUE  ! END (all,r,REG)
    1 CONTINUE  ! END (all,i,PROD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "compvalad"',
     *  ' using equation "COMPVALADEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01354')
      RETURN
      END
      SUBROUTINE S01355(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00171,C00173,C00174,C00347,
     *  V00005,V00032,V00106,V00107,V00113,V00114,V00115,V00116,
     *  V00120,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL C00173(SSZ(2),SSZ(1),SSZ(1))
      REAL C00174(SSZ(2),SSZ(1),SSZ(1))
      REAL C00347(SSZ(2),SSZ(1),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00032(SSZ(2),SSZ(1),SSZ(1))
      REAL V00106(SSZ(2),SSZ(1))
      REAL V00107(SSZ(2),SSZ(1),SSZ(1))
      REAL V00113(SSZ(2))
      REAL V00114(SSZ(2))
      REAL V00115(SSZ(1))
      REAL V00116(SSZ(1))
      REAL V00120(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "pcif"'
      CurrentAction2=
     *  ' using equation "FOBCIF"'
      CurrentIGNO=792
      CurrentIGTP='bs'
      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)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 4 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS1=RS1+C00174(I00001,I00002,I00003)*
     *  C00171(I00005,I00001,I00002,I00003)*V00113(SSMP(SSMPST(1)-1+
     *  I00005))
    4 CONTINUE  ! END SUM(m,MARG_COMM
      RS2=0.0
      DO 5 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS2=RS2-C00174(I00001,I00002,I00003)*
     *  C00171(I00005,I00001,I00002,I00003)*V00120(I00005)
    5 CONTINUE  ! END SUM(m,MARG_COMM
      V00032(I00001,I00002,I00003)=-(-C00173(I00001,I00002,I00003)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+
     *  C00173(I00001,I00002,I00003)*V00106(I00001,I00002)+
     *  C00173(I00001,I00002,I00003)*V00107(I00001,I00002,I00003)+RS1+
     *  C00347(I00001,I00002,I00003)*V00114(I00001)+
     *  C00347(I00001,I00002,I00003)*V00115(I00002)+
     *  C00347(I00001,I00002,I00003)*V00116(I00003)+RS2)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "pcif"',
     *  ' using equation "FOBCIF"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01355')
      RETURN
      END
      SUBROUTINE S01356(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00112,V00113,V00114,V00115,V00116,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00112(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00113(SSZ(2))
      REAL V00114(SSZ(2))
      REAL V00115(SSZ(1))
      REAL V00116(SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "atmfsd"'
      CurrentAction2=
     *  ' using equation "TRANSTECHANGE"'
      CurrentIGNO=784
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "atmfsd"',
     *  ' using equation "TRANSTECHANGE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      V00112(I00005,I00001,I00002,I00003)=(V00113(SSMP(SSMPST(1)-1+
     *  I00005))+V00114(I00001)+V00115(I00002)+V00116(I00003))
    4 CONTINUE  ! END (all,s,REG)
    3 CONTINUE  ! END (all,r,REG)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    1 CONTINUE  ! END (all,m,MARG_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "atmfsd"',
     *  ' using equation "TRANSTECHANGE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01356')
      RETURN
      END
      SUBROUTINE S01357(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00171,
     *  V00112,V00118,V00120,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      REAL C00171(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00112(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00118(SSZ(2),SSZ(1),SSZ(1))
      REAL V00120(SSZ(3))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "ptrans"'
      CurrentAction2=
     *  ' using equation "TRANSCOSTINDEX"'
      CurrentIGNO=783
      CurrentIGTP='bs'
      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)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=0.0
      DO 4 I00005=1,SSZ(3)  ! SUM(m,MARG_COMM
      RS1=RS1+C00171(I00005,I00001,I00002,I00003)*(V00120(I00005)-
     *  V00112(I00005,I00001,I00002,I00003))
    4 CONTINUE  ! END SUM(m,MARG_COMM
      V00118(I00001,I00002,I00003)=RS1
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "ptrans"',
     *  ' using equation "TRANSCOSTINDEX"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01357')
      RETURN
      END
      SUBROUTINE S01358(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00031,V00111,V00112,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00111(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00112(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "qtmfsd"'
      CurrentAction2=
     *  ' using equation "QTRANS_MFSD"'
      CurrentIGNO=769
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qtmfsd"',
     *  ' using equation "QTRANS_MFSD"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      V00111(I00005,I00001,I00002,I00003)=(V00031(I00001,I00002,I00003)-
     *  V00112(I00005,I00001,I00002,I00003))
    4 CONTINUE  ! END (all,s,REG)
    3 CONTINUE  ! END (all,r,REG)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    1 CONTINUE  ! END (all,m,MARG_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "qtmfsd"',
     *  ' using equation "QTRANS_MFSD"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01358')
      RETURN
      END
      SUBROUTINE S01359(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00030,V00032,V00108,V00109,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00030(SSZ(2),SSZ(1),SSZ(1))
      REAL V00032(SSZ(2),SSZ(1),SSZ(1))
      REAL V00108(SSZ(2),SSZ(1))
      REAL V00109(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "pms"'
      CurrentAction2=
     *  ' using equation "MKTPRICES"'
      CurrentIGNO=736
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pms"',
     *  ' using equation "MKTPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      V00030(I00001,I00002,I00003)=(V00108(I00001,I00003)+
     *  V00109(I00001,I00002,I00003)+V00032(I00001,I00002,I00003))
    3 CONTINUE  ! END (all,s,REG)
    2 CONTINUE  ! END (all,r,REG)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "pms"',
     *  ' using equation "MKTPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01359')
      RETURN
      END
      SUBROUTINE S01360(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00005,V00033,V00106,V00107,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00033(SSZ(2),SSZ(1),SSZ(1))
      REAL V00106(SSZ(2),SSZ(1))
      REAL V00107(SSZ(2),SSZ(1),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "pfob"'
      CurrentAction2=
     *  ' using equation "EXPRICES"'
      CurrentIGNO=732
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pfob"',
     *  ' using equation "EXPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      V00033(I00001,I00002,I00003)=(V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)-V00106(I00001,I00002)-
     *  V00107(I00001,I00002,I00003))
    3 CONTINUE  ! END (all,s,REG)
    2 CONTINUE  ! END (all,r,REG)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "pfob"',
     *  ' using equation "EXPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01360')
      RETURN
      END
      SUBROUTINE S01361(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00020,V00083,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00020(SSZ(6),SSZ(7),SSZ(1))
      REAL V00083(SSZ(35),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "qfe"'
      CurrentAction2=
     *  ' using equation "QFEEQ"'
      CurrentIGNO=527
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qfe"',
     *  ' using equation "QFEEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      V00020(I00001,I00004,I00002)=V00083(SSMP(SSMPST(35)-1+
     *  SSMP(SSMPST(5)-1+I00001)),I00004,I00002)
    3 CONTINUE  ! END (all,r,REG)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    1 CONTINUE  ! END (all,i,ENDW_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "qfe"',
     *  ' using equation "QFEEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01361')
      RETURN
      END
      SUBROUTINE S01362(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00084,V00087,V00088,V00089,V00090,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00084(SSZ(35),SSZ(7),SSZ(1))
      REAL V00087(SSZ(35))
      REAL V00088(SSZ(7))
      REAL V00089(SSZ(1))
      REAL V00090(SSZ(35),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "af"'
      CurrentAction2=
     *  ' using equation "AFWORLD"'
      CurrentIGNO=533
      CurrentIGTP='bs'
      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(35)  ! (all,i,FIRM_COMM)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      V00084(I00001,I00004,I00002)=(V00087(I00001)+V00088(I00004)+
     *  V00089(I00002)+V00090(I00001,I00004,I00002))
    3 CONTINUE  ! END (all,r,REG)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    1 CONTINUE  ! END (all,i,FIRM_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "af"',
     *  ' using equation "AFWORLD"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01362')
      RETURN
      END
      SUBROUTINE S01363(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00091,V00092,V00093,V00094,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00091(SSZ(7),SSZ(1))
      REAL V00092(SSZ(7))
      REAL V00093(SSZ(1))
      REAL V00094(SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "ao"'
      CurrentAction2=
     *  ' using equation "AOWORLD"'
      CurrentIGNO=681
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "ao"',
     *  ' using equation "AOWORLD"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      V00091(I00004,I00002)=(V00092(I00004)+V00093(I00002)+
     *  V00094(I00004,I00002))
    2 CONTINUE  ! END (all,r,REG)
    1 CONTINUE  ! END (all,j,PROD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "ao"',
     *  ' using equation "AOWORLD"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01363')
      RETURN
      END
      SUBROUTINE S01364(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00076,C00119,C00120,C00121,C00122,C00123,
     *  V00005,V00009,V00023,V00025,V00026,V00041,V00083,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00023(SSZ(2),SSZ(7),SSZ(1))
      REAL V00025(SSZ(2),SSZ(7),SSZ(1))
      REAL V00026(SSZ(2),SSZ(7),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00083(SSZ(35),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "qfm"'
      CurrentAction2=
     *  ' using equation "INDIMP"'
      CurrentIGNO=522
      CurrentIGTP='bs'
      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)  ! (all,s,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=-C00076(I00001)*(1  -C00123(I00001,I00004,I00003))*
     *  C00119(I00001,I00004,I00003)*V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00003)+(C00076(I00001)*
     *  C00121(I00001,I00004,I00003)-C00076(I00001)*
     *  C00123(I00001,I00004,I00003)*C00121(I00001,I00004,I00003))*
     *  V00009(I00001,I00003)-C00076(I00001)*(1  -
     *  C00123(I00001,I00004,I00003))*C00119(I00001,I00004,I00003)*
     *  V00023(I00001,I00004,I00003)
      RS2=RS1+(C00076(I00001)*C00121(I00001,I00004,I00003)-
     *  C00076(I00001)*C00123(I00001,I00004,I00003)*
     *  C00121(I00001,I00004,I00003))*V00026(I00001,I00004,I00003)+
     *  (C00076(I00001)*100.0 *C00122(I00001,I00004,I00003)+
     *  C00076(I00001)*(-C00123(I00001,I00004,I00003)*100.0 *
     *  C00122(I00001,I00004,I00003)-(1  -C00123(I00001,I00004,I00003))*
     *  100.0 *C00120(I00001,I00004,I00003)))*V00041(C00008(I00003))
      V00025(I00001,I00004,I00003)=-(RS2-1.0*V00083(SSMP(SSMPST(35)-1+
     *  SSMP(SSMPST(6)-1+I00001)),I00004,I00003))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "qfm"',
     *  ' using equation "INDIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01364')
      RETURN
      END
      SUBROUTINE S01365(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00119,C00120,C00121,C00122,C00123,
     *  V00005,V00009,V00023,V00026,V00041,V00080,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL C00123(SSZ(2),SSZ(7),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00023(SSZ(2),SSZ(7),SSZ(1))
      REAL V00026(SSZ(2),SSZ(7),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00080(SSZ(2),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "pft"'
      CurrentAction2=
     *  ' using equation "ICOMPRICE"'
      CurrentIGNO=521
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pft"',
     *  ' using equation "ICOMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=-(1  -C00123(I00001,I00004,I00002))*
     *  C00119(I00001,I00004,I00002)*V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)-C00123(I00001,I00004,I00002)*
     *  C00121(I00001,I00004,I00002)*V00009(I00001,I00002)-(1  -
     *  C00123(I00001,I00004,I00002))*C00119(I00001,I00004,I00002)*
     *  V00023(I00001,I00004,I00002)-C00123(I00001,I00004,I00002)*
     *  C00121(I00001,I00004,I00002)*V00026(I00001,I00004,I00002)
      V00080(I00001,I00004,I00002)=-(RS1+(-C00123(I00001,I00004,I00002)*
     *  100.0 *C00122(I00001,I00004,I00002)-(1  -
     *  C00123(I00001,I00004,I00002))*100.0 *
     *  C00120(I00001,I00004,I00002))*V00041(C00008(I00002)))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "pft"',
     *  ' using equation "ICOMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01365')
      RETURN
      END
      SUBROUTINE S01366(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00121,C00122,
     *  V00009,V00024,V00026,V00041,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00121(SSZ(2),SSZ(7),SSZ(1))
      REAL C00122(SSZ(2),SSZ(7),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00024(SSZ(2),SSZ(7),SSZ(1))
      REAL V00026(SSZ(2),SSZ(7),SSZ(1))
      REAL V00041(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "pfm"'
      CurrentAction2=
     *  ' using equation "DMNDIPRICES"'
      CurrentIGNO=517
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pfm"',
     *  ' using equation "DMNDIPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00024(I00001,I00004,I00002)=(C00121(I00001,I00004,I00002)*
     *  (V00009(I00001,I00002)+V00026(I00001,I00004,I00002))+100.0 *
     *  C00122(I00001,I00004,I00002)*V00041(C00008(I00002)))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "pfm"',
     *  ' using equation "DMNDIPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01366')
      RETURN
      END
      SUBROUTINE S01367(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00119,C00120,
     *  V00005,V00021,V00023,V00041,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00119(SSZ(2),SSZ(7),SSZ(1))
      REAL C00120(SSZ(2),SSZ(7),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00021(SSZ(2),SSZ(7),SSZ(1))
      REAL V00023(SSZ(2),SSZ(7),SSZ(1))
      REAL V00041(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "pfd"'
      CurrentAction2=
     *  ' using equation "DMNDDPRICE"'
      CurrentIGNO=508
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pfd"',
     *  ' using equation "DMNDDPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00021(I00001,I00004,I00002)=(C00119(I00001,I00004,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+
     *  V00023(I00001,I00004,I00002))+100.0 *
     *  C00120(I00001,I00004,I00002)*V00041(C00008(I00002)))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "pfd"',
     *  ' using equation "DMNDDPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01367')
      RETURN
      END
      SUBROUTINE S01368(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00081,V00083,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00081(SSZ(2),SSZ(7),SSZ(1))
      REAL V00083(SSZ(35),SSZ(7),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "qft"'
      CurrentAction2=
     *  ' using equation "QFTEQ"'
      CurrentIGNO=528
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qft"',
     *  ' using equation "QFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      V00081(I00001,I00004,I00002)=V00083(SSMP(SSMPST(35)-1+
     *  SSMP(SSMPST(6)-1+I00001)),I00004,I00002)
    3 CONTINUE  ! END (all,r,REG)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "qft"',
     *  ' using equation "QFTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01368')
      RETURN
      END
      SUBROUTINE S01369(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00100,C00101,C00102,C00103,C00104,
     *  V00005,V00009,V00013,V00016,V00041,V00075,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL C00104(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00013(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00075(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "ppt"'
      CurrentAction2=
     *  ' using equation "PCOMPRICE"'
      CurrentIGNO=429
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "ppt"',
     *  ' using equation "PCOMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=-(1  -C00104(I00001,I00003))*C00100(I00001,I00003)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00003)-
     *  C00104(I00001,I00003)*C00102(I00001,I00003)*
     *  V00009(I00001,I00003)-(1  -C00104(I00001,I00003))*
     *  C00100(I00001,I00003)*V00013(I00001,I00003)-
     *  C00104(I00001,I00003)*C00102(I00001,I00003)*
     *  V00016(I00001,I00003)
      V00075(I00001,I00003)=-(RS1+(-C00104(I00001,I00003)*100.0 *
     *  C00103(I00001,I00003)-(1  -C00104(I00001,I00003))*100.0 *
     *  C00101(I00001,I00003))*V00041(C00008(I00003)))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "ppt"',
     *  ' using equation "PCOMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01369')
      RETURN
      END
      SUBROUTINE S01370(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00076,C00102,C00103,
     *  V00009,V00015,V00016,V00041,V00074,V00075,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00015(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00074(SSZ(27),SSZ(1))
      REAL V00075(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "qpm"'
      CurrentAction2=
     *  ' using equation "PHHLDAGRIMP"'
      CurrentIGNO=431
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qpm"',
     *  ' using equation "PHHLDAGRIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00015(I00001,I00003)=-(C00076(I00001)*C00102(I00001,I00003)*
     *  V00009(I00001,I00003)+C00076(I00001)*C00102(I00001,I00003)*
     *  V00016(I00001,I00003)+C00076(I00001)*100.0 *
     *  C00103(I00001,I00003)*V00041(C00008(I00003))-1.0*
     *  V00074(SSMP(SSMPST(26)-1+I00001),I00003)-C00076(I00001)*
     *  V00075(I00001,I00003))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "qpm"',
     *  ' using equation "PHHLDAGRIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00008,C00102,C00103,
     *  V00009,V00014,V00016,V00041,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00102(SSZ(2),SSZ(1))
      REAL C00103(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00014(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "ppm"'
      CurrentAction2=
     *  ' using equation "PHHIPRICES"'
      CurrentIGNO=425
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "ppm"',
     *  ' using equation "PHHIPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00014(I00001,I00002)=(C00102(I00001,I00002)*
     *  (V00009(I00001,I00002)+V00016(I00001,I00002))+100.0 *
     *  C00103(I00001,I00002)*V00041(C00008(I00002)))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "ppm"',
     *  ' using equation "PHHIPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00008,C00100,C00101,
     *  V00005,V00011,V00013,V00041,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00100(SSZ(2),SSZ(1))
      REAL C00101(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00011(SSZ(2),SSZ(1))
      REAL V00013(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "ppd"'
      CurrentAction2=
     *  ' using equation "PHHDPRICE"'
      CurrentIGNO=414
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "ppd"',
     *  ' using equation "PHHDPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00011(I00001,I00002)=(C00100(I00001,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+
     *  V00013(I00001,I00002))+100.0 *C00101(I00001,I00002)*
     *  V00041(C00008(I00002)))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "ppd"',
     *  ' using equation "PHHDPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  V00074,V00076,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00074(SSZ(27),SSZ(1))
      REAL V00076(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "qpt"'
      CurrentAction2=
     *  ' using equation "QPTEQ"'
      CurrentIGNO=434
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qpt"',
     *  ' using equation "QPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      V00076(I00001,I00002)=V00074(SSMP(SSMPST(26)-1+I00001),I00002)
    2 CONTINUE  ! END (all,r,REG)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "qpt"',
     *  ' using equation "QPTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00049,C00084,
     *  V00047,V00069,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1,RS2,RS3,RS4
      LOGICAL ECHO1
      REAL C00049(SSZ(1))
      REAL C00084(SSZ(19),SSZ(1))
      REAL V00047(SSZ(1))
      REAL V00069(SSZ(19),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "pgov"'
      CurrentAction2=
     *  ' using equation "GPRICEINDEX"'
      CurrentIGNO=388
      CurrentIGTP='bs'
      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)  ! (all,r,REG)
      RS1=0.0
      DO 2 I00001=1,SSZ(25)  ! SUM(i,UG_COMM
      RS2=C00084(SSMP(SSMPST(25)-1+I00001),I00002)
      RS3=C00049(I00002)
      IF(RS3.NE.0.0) THEN
        RS4=RS2/RS3
      ELSE
        RS4=1.0
        IF (IER.EQ.0) THEN
         IER=2
         ErrorDivNo=1
         NumActiveInd=2
         ErrorRVal1=RS2
         ErrorRVal2=RS3
         ErrorIndName(1)='r           '
         ErrorIndVal(1)=I00002
         ErrorIndSetNo(1)=1
         ErrorIndName(2)='i           '
         ErrorIndVal(2)=I00001
         ErrorIndSetNo(2)=25
        END IF
      END IF
      RS1=RS1+RS4*V00069(SSMP(SSMPST(25)-1+I00001),I00002)
    2 CONTINUE  ! END SUM(i,UG_COMM
      V00047(I00002)=RS1
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "pgov"',
     *  ' using equation "GPRICEINDEX"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01374')
      RETURN
      END
      SUBROUTINE M00033(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  AXSUN,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 AXSUN
      INTEGER KSINT,NSINT,KSINTA,KSUBTO
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) ERRMES
      LOGICAL FSTPAS
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfeir','CONT_EV_qfeir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01350(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00068,C00243,C00321,
     *  V00044,V00083,V00216,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqfer','CONT_EV_qfer',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01351(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00068,C00243,C00320,
     *  V00044,V00083,V00215,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqoir','CONT_EV_qoir',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01352(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00070,C00243,
     *  V00018,V00044,V00214,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'CNTqor','CONT_EV_qor',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01353(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00070,C00243,
     *  V00018,V00044,V00213,
     *  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 S01354(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00018,V00162,V00163,
     *  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 S01355(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00171,C00173,C00174,C00347,
     *  V00005,V00032,V00106,V00107,V00113,V00114,V00115,V00116,
     *  V00120,
     *  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 S01356(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00112,V00113,V00114,V00115,V00116,
     *  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 S01357(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00171,
     *  V00112,V00118,V00120,
     *  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 S01358(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00031,V00111,V00112,
     *  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 S01359(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00030,V00032,V00108,V00109,
     *  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 S01360(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00005,V00033,V00106,V00107,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qfe','QFEEQ',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01361(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00020,V00083,
     *  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 S01362(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00084,V00087,V00088,V00089,V00090,
     *  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 S01363(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00091,V00092,V00093,V00094,
     *  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 S01364(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00076,C00119,C00120,C00121,C00122,C00123,
     *  V00005,V00009,V00023,V00025,V00026,V00041,V00083,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pft','ICOMPRICE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01365(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00119,C00120,C00121,C00122,C00123,
     *  V00005,V00009,V00023,V00026,V00041,V00080,
     *  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 S01366(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00121,C00122,
     *  V00009,V00024,V00026,V00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pfd','DMNDDPRICE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01367(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00119,C00120,
     *  V00005,V00021,V00023,V00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qft','QFTEQ',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01368(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00081,V00083,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'ppt','PCOMPRICE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01369(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00100,C00101,C00102,C00103,C00104,
     *  V00005,V00009,V00013,V00016,V00041,V00075,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qpm','PHHLDAGRIMP',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01370(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00076,C00102,C00103,
     *  V00009,V00015,V00016,V00041,V00074,V00075,
     *  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 S01371(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00102,C00103,
     *  V00009,V00014,V00016,V00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'ppd','PHHDPRICE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01372(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00100,C00101,
     *  V00005,V00011,V00013,V00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'qpt','QPTEQ',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01373(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00074,V00076,
     *  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 S01374(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00049,C00084,
     *  V00047,V00069,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00033')
      RETURN
      END
      SUBROUTINE S01375(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00070,V00072,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL V00070(SSZ(19),SSZ(1))
      REAL V00072(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "qgt"'
      CurrentAction2=
     *  ' using equation "QGTEQ"'
      CurrentIGNO=352
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "qgt"',
     *  ' using equation "QGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      V00072(I00001,I00002)=V00070(SSMP(SSMPST(17)-1+I00001),I00002)
    2 CONTINUE  ! END (all,r,REG)
    1 CONTINUE  ! END (all,i,TRAD_COMM)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "qgt"',
     *  ' using equation "QGTEQ"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01375')
      RETURN
      END
      SUBROUTINE S01376(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00076,C00086,C00087,C00088,C00089,C00090,
     *  V00005,V00006,V00008,V00009,V00010,V00041,V00072,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00076(SSZ(2))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00006(SSZ(2),SSZ(1))
      REAL V00008(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00010(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00072(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "qgm"'
      CurrentAction2=
     *  ' using equation "GHHLDAGRIMP"'
      CurrentIGNO=347
      CurrentIGTP='bs'
      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)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=-C00076(I00001)*(1  -C00090(I00001,I00003))*
     *  C00086(I00001,I00003)*V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00003)-C00076(I00001)*(1  -C00090(I00001,I00003))*
     *  C00086(I00001,I00003)*V00006(I00001,I00003)+(C00076(I00001)*
     *  C00088(I00001,I00003)-C00076(I00001)*C00090(I00001,I00003)*
     *  C00088(I00001,I00003))*V00009(I00001,I00003)
      V00008(I00001,I00003)=-(RS1+(C00076(I00001)*C00088(I00001,I00003)-
     *  C00076(I00001)*C00090(I00001,I00003)*C00088(I00001,I00003))*
     *  V00010(I00001,I00003)+(C00076(I00001)*100.0 *
     *  C00089(I00001,I00003)+C00076(I00001)*(-C00090(I00001,I00003)*
     *  100.0 *C00089(I00001,I00003)-(1  -C00090(I00001,I00003))*100.0 *
     *  C00087(I00001,I00003)))*V00041(C00008(I00003))-1.0*
     *  V00072(I00001,I00003))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "qgm"',
     *  ' using equation "GHHLDAGRIMP"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00008,C00086,C00087,C00088,C00089,C00090,
     *  V00005,V00006,V00009,V00010,V00041,V00071,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      REAL RS1
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL C00090(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00006(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00010(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      REAL V00071(SSZ(2),SSZ(1))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "pgt"'
      CurrentAction2=
     *  ' using equation "GCOMPRICE"'
      CurrentIGNO=346
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pgt"',
     *  ' using equation "GCOMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      RS1=-(1  -C00090(I00001,I00003))*C00086(I00001,I00003)*
     *  V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00003)-(1  -
     *  C00090(I00001,I00003))*C00086(I00001,I00003)*
     *  V00006(I00001,I00003)-C00090(I00001,I00003)*
     *  C00088(I00001,I00003)*V00009(I00001,I00003)-
     *  C00090(I00001,I00003)*C00088(I00001,I00003)*
     *  V00010(I00001,I00003)
      V00071(I00001,I00003)=-(RS1+(-C00090(I00001,I00003)*100.0 *
     *  C00089(I00001,I00003)-(1  -C00090(I00001,I00003))*100.0 *
     *  C00087(I00001,I00003))*V00041(C00008(I00003)))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "pgt"',
     *  ' using equation "GCOMPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,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,AXSUN,
     *  C00008,C00088,C00089,
     *  V00007,V00009,V00010,V00041,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00088(SSZ(2),SSZ(1))
      REAL C00089(SSZ(2),SSZ(1))
      REAL V00007(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00010(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "pgm"'
      CurrentAction2=
     *  ' using equation "GHHIPRICES"'
      CurrentIGNO=343
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pgm"',
     *  ' using equation "GHHIPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00007(I00001,I00002)=(C00088(I00001,I00002)*
     *  (V00009(I00001,I00002)+V00010(I00001,I00002))+100.0 *
     *  C00089(I00001,I00002)*V00041(C00008(I00002)))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "pgm"',
     *  ' using equation "GHHIPRICES"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01378')
      RETURN
      END
      SUBROUTINE S01379(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00086,C00087,
     *  V00003,V00005,V00006,V00041,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00086(SSZ(2),SSZ(1))
      REAL C00087(SSZ(2),SSZ(1))
      REAL V00003(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00006(SSZ(2),SSZ(1))
      REAL V00041(SSZ(17))
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CurrentAction=
     *  'backsolve for variable "pgd"'
      CurrentAction2=
     *  ' using equation "GHHDPRICE"'
      CurrentIGNO=334
      CurrentIGTP='bs'
      CALL GPAPRW(
     *  ' before calculating backsolve for variable "pgd"',
     *  ' using equation "GHHDPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      V00003(I00001,I00002)=(C00086(I00001,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+I00001)),I00002)+
     *  V00006(I00001,I00002))+100.0 *C00087(I00001,I00002)*
     *  V00041(C00008(I00002)))
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating backsolve for variable "pgd"',
     *  ' using equation "GHHDPRICE"',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
9000  CONTINUE
      call SKARB(axsun,1,filpb,tfilpb,errmes)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01379')
      RETURN
      END
      SUBROUTINE M00034(
     *  KSINT,NSINT,KSINTA,KSUBTO,
     *  AXSUN,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 AXSUN
      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''',
     *    'qgt','QGTEQ',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01375(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  V00070,V00072,
     *  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 S01376(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00076,C00086,C00087,C00088,C00089,C00090,
     *  V00005,V00006,V00008,V00009,V00010,V00041,V00072,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
       IF(ECHO1) THEN
        CALL GPTO2(' Backsolving for variable ''%t''',
     *    ' using equation ''%t''',
     *    'pgt','GCOMPRICE',0,0,ERRMES)
        IF(ERRMES(1:1).EQ.'E') GOTO 15000
       END IF
      CALL S01377(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00086,C00087,C00088,C00089,C00090,
     *  V00005,V00006,V00009,V00010,V00041,V00071,
     *  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 S01378(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00088,C00089,
     *  V00007,V00009,V00010,V00041,
     *  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 S01379(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00086,C00087,
     *  V00003,V00005,V00006,V00041,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00034')
      RETURN
      END
      SUBROUTINE S01380(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00001,
     *  U00001,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      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,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VERNUM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VERNUM"'
      CurrentAction2=
     *  'at line 217 in the TAB file'
      CurrentIGNO=7
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VERNUM"',
     *  'at line 217 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      U00001(1)=C00001(1)*0.0
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VERNUM"',
     *  'at line 217 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      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
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,1,
     *  ' while completing update of coefficient "VERNUM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01380')
      RETURN
      END
      SUBROUTINE S01383(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00009,
     *  V00001,V00002,
     *  U00009,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00009(SSZ(1))
      REAL V00001(SSZ(1))
      REAL V00002(SSZ(1))
      REAL U00009(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "SAVE"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "SAVE"'
      CurrentAction2=
     *  'at line 400 in the TAB file'
      CurrentIGNO=61
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "SAVE"',
     *  'at line 400 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00009(I00002)=C00009(I00002)*(V00001(I00002)/100.0 +
     *  V00002(I00002)/100.0 )
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "SAVE"',
     *  'at line 400 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00009),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(9),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00009,U00009,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,9,
     *  ' while completing update of coefficient "SAVE"',
     *  ' ',
     *  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,AXSUN,
     *  C00010,
     *  V00003,V00004,
     *  U00010,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00010(SSZ(2),SSZ(1))
      REAL V00003(SSZ(2),SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL U00010(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VDGA"'
      CurrentAction2=
     *  'at line 417 in the TAB file'
      CurrentIGNO=66
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGA"',
     *  'at line 417 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00010(I00001,I00002)=C00010(I00001,I00002)*
     *  (V00003(I00001,I00002)/100.0 +V00004(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VDGA"',
     *  'at line 417 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00010),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(10),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00010,U00010,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,10,
     *  ' while completing update of coefficient "VDGA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01384')
      RETURN
      END
      SUBROUTINE S01385(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00011,
     *  V00004,V00005,V00006,
     *  U00011,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00011(SSZ(2),SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00006(SSZ(2),SSZ(1))
      REAL U00011(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VDGANC"'
      CurrentAction2=
     *  'at line 429 in the TAB file'
      CurrentIGNO=71
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGANC"',
     *  'at line 429 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00011(I00001,I00002)=C00011(I00001,I00002)*
     *  (V00006(I00001,I00002)/100.0 +V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)/100.0 +
     *  V00004(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VDGANC"',
     *  'at line 429 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00011),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(11),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00011,U00011,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,11,
     *  ' while completing update of coefficient "VDGANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01385')
      RETURN
      END
      SUBROUTINE S01386(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00012,
     *  V00004,V00005,
     *  U00012,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00012(SSZ(2),SSZ(1))
      REAL V00004(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL U00012(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VDGM"'
      CurrentAction2=
     *  'at line 437 in the TAB file'
      CurrentIGNO=74
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDGM"',
     *  'at line 437 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00012(I00001,I00002)=C00012(I00001,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00004(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VDGM"',
     *  'at line 437 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00012),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(12),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00012,U00012,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,12,
     *  ' while completing update of coefficient "VDGM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01386')
      RETURN
      END
      SUBROUTINE S01387(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00013,
     *  V00007,V00008,
     *  U00013,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00013(SSZ(2),SSZ(1))
      REAL V00007(SSZ(2),SSZ(1))
      REAL V00008(SSZ(2),SSZ(1))
      REAL U00013(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VIGA"'
      CurrentAction2=
     *  'at line 448 in the TAB file'
      CurrentIGNO=79
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGA"',
     *  'at line 448 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00013(I00001,I00002)=C00013(I00001,I00002)*
     *  (V00007(I00001,I00002)/100.0 +V00008(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VIGA"',
     *  'at line 448 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00013),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(13),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00013,U00013,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,13,
     *  ' while completing update of coefficient "VIGA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01387')
      RETURN
      END
      SUBROUTINE S01388(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00014,
     *  V00008,V00009,V00010,
     *  U00014,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00014(SSZ(2),SSZ(1))
      REAL V00008(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00010(SSZ(2),SSZ(1))
      REAL U00014(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VIGANC"'
      CurrentAction2=
     *  'at line 460 in the TAB file'
      CurrentIGNO=84
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGANC"',
     *  'at line 460 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00014(I00001,I00002)=C00014(I00001,I00002)*
     *  (V00010(I00001,I00002)/100.0 +V00009(I00001,I00002)/100.0 +
     *  V00008(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VIGANC"',
     *  'at line 460 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00014),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(14),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00014,U00014,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,14,
     *  ' while completing update of coefficient "VIGANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01388')
      RETURN
      END
      SUBROUTINE S01389(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00015,
     *  V00008,V00009,
     *  U00015,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00015(SSZ(2),SSZ(1))
      REAL V00008(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL U00015(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VIGM"'
      CurrentAction2=
     *  'at line 468 in the TAB file'
      CurrentIGNO=87
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIGM"',
     *  'at line 468 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00015(I00001,I00002)=C00015(I00001,I00002)*
     *  (V00009(I00001,I00002)/100.0 +V00008(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VIGM"',
     *  'at line 468 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00015),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(15),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00015,U00015,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,15,
     *  ' while completing update of coefficient "VIGM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01389')
      RETURN
      END
      SUBROUTINE S01390(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00016,
     *  V00011,V00012,
     *  U00016,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00016(SSZ(2),SSZ(1))
      REAL V00011(SSZ(2),SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL U00016(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VDPA"'
      CurrentAction2=
     *  'at line 485 in the TAB file'
      CurrentIGNO=92
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPA"',
     *  'at line 485 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00016(I00001,I00002)=C00016(I00001,I00002)*
     *  (V00011(I00001,I00002)/100.0 +V00012(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VDPA"',
     *  'at line 485 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00016),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(16),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00016,U00016,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,16,
     *  ' while completing update of coefficient "VDPA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01390')
      RETURN
      END
      SUBROUTINE S01391(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00017,
     *  V00005,V00012,V00013,
     *  U00017,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00017(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL V00013(SSZ(2),SSZ(1))
      REAL U00017(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VDPANC"'
      CurrentAction2=
     *  'at line 495 in the TAB file'
      CurrentIGNO=96
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPANC"',
     *  'at line 495 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00017(I00001,I00002)=C00017(I00001,I00002)*
     *  (V00013(I00001,I00002)/100.0 +V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)/100.0 +
     *  V00012(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VDPANC"',
     *  'at line 495 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00017),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(17),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00017,U00017,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,17,
     *  ' while completing update of coefficient "VDPANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01391')
      RETURN
      END
      SUBROUTINE S01392(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00018,
     *  V00005,V00012,
     *  U00018,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00018(SSZ(2),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00012(SSZ(2),SSZ(1))
      REAL U00018(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VDPM"'
      CurrentAction2=
     *  'at line 502 in the TAB file'
      CurrentIGNO=99
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDPM"',
     *  'at line 502 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00018(I00001,I00002)=C00018(I00001,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00012(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VDPM"',
     *  'at line 502 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00018),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(18),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00018,U00018,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,18,
     *  ' while completing update of coefficient "VDPM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01392')
      RETURN
      END
      SUBROUTINE S01393(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00019,
     *  V00014,V00015,
     *  U00019,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00019(SSZ(2),SSZ(1))
      REAL V00014(SSZ(2),SSZ(1))
      REAL V00015(SSZ(2),SSZ(1))
      REAL U00019(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VIPA"'
      CurrentAction2=
     *  'at line 513 in the TAB file'
      CurrentIGNO=104
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPA"',
     *  'at line 513 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00019(I00001,I00002)=C00019(I00001,I00002)*
     *  (V00014(I00001,I00002)/100.0 +V00015(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VIPA"',
     *  'at line 513 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00019),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(19),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00019,U00019,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,19,
     *  ' while completing update of coefficient "VIPA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01393')
      RETURN
      END
      SUBROUTINE S01394(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00020,
     *  V00009,V00015,V00016,
     *  U00020,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00020(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00015(SSZ(2),SSZ(1))
      REAL V00016(SSZ(2),SSZ(1))
      REAL U00020(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VIPANC"'
      CurrentAction2=
     *  'at line 523 in the TAB file'
      CurrentIGNO=108
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPANC"',
     *  'at line 523 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00020(I00001,I00002)=C00020(I00001,I00002)*
     *  (V00016(I00001,I00002)/100.0 +V00009(I00001,I00002)/100.0 +
     *  V00015(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VIPANC"',
     *  'at line 523 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00020),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(20),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00020,U00020,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,20,
     *  ' while completing update of coefficient "VIPANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01394')
      RETURN
      END
      SUBROUTINE S01395(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00021,
     *  V00009,V00015,
     *  U00021,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00021(SSZ(2),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00015(SSZ(2),SSZ(1))
      REAL U00021(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VIPM"'
      CurrentAction2=
     *  'at line 530 in the TAB file'
      CurrentIGNO=111
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIPM"',
     *  'at line 530 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00021(I00001,I00002)=C00021(I00001,I00002)*
     *  (V00009(I00001,I00002)/100.0 +V00015(I00001,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VIPM"',
     *  'at line 530 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00021),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(21),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00021,U00021,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,21,
     *  ' while completing update of coefficient "VIPM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01395')
      RETURN
      END
      SUBROUTINE S01396(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00022,
     *  V00017,V00018,
     *  U00022,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00022(SSZ(6),SSZ(1))
      REAL V00017(SSZ(9),SSZ(1))
      REAL V00018(SSZ(9),SSZ(1))
      REAL U00022(SSZ(6),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "EVOA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "EVOA"'
      CurrentAction2=
     *  'at line 547 in the TAB file'
      CurrentIGNO=116
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "EVOA"',
     *  'at line 547 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      U00022(I00001,I00002)=C00022(I00001,I00002)*
     *  (V00017(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+
     *  I00001)),I00002)/100.0 +V00018(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-
     *  1+I00001)),I00002)/100.0 )
    1 CONTINUE  ! END (all,i,ENDW_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "EVOA"',
     *  'at line 547 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00022),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(22),KSTEP,NSTEP,METHOD,
     *    SSZ(6),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(6),SSZ(1),1,1,
     *    1,1,1,
     *    C00022,U00022,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,22,
     *  ' while completing update of coefficient "EVOA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01396')
      RETURN
      END
      SUBROUTINE S01397(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00023,
     *  V00019,V00020,
     *  U00023,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00023(SSZ(6),SSZ(7),SSZ(1))
      REAL V00019(SSZ(6),SSZ(7),SSZ(1))
      REAL V00020(SSZ(6),SSZ(7),SSZ(1))
      REAL U00023(SSZ(6),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "EVFA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "EVFA"'
      CurrentAction2=
     *  'at line 558 in the TAB file'
      CurrentIGNO=121
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "EVFA"',
     *  'at line 558 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(6)  ! (all,i,ENDW_COMM)
      U00023(I00001,I00004,I00002)=C00023(I00001,I00004,I00002)*
     *  (V00019(I00001,I00004,I00002)/100.0 +
     *  V00020(I00001,I00004,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,ENDW_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "EVFA"',
     *  'at line 558 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00023),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(23),KSTEP,NSTEP,METHOD,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00023,U00023,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,23,
     *  ' while completing update of coefficient "EVFA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01397')
      RETURN
      END
      SUBROUTINE S01398(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00024,
     *  V00021,V00022,
     *  U00024,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00024(SSZ(2),SSZ(7),SSZ(1))
      REAL V00021(SSZ(2),SSZ(7),SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL U00024(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VDFA"'
      CurrentAction2=
     *  'at line 569 in the TAB file'
      CurrentIGNO=126
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFA"',
     *  'at line 569 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00024(I00001,I00004,I00002)=C00024(I00001,I00004,I00002)*
     *  (V00021(I00001,I00004,I00002)/100.0 +
     *  V00022(I00001,I00004,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VDFA"',
     *  'at line 569 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00024),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(24),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00024,U00024,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,24,
     *  ' while completing update of coefficient "VDFA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01398')
      RETURN
      END
      SUBROUTINE S01399(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00025,
     *  V00005,V00022,V00023,
     *  U00025,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00025(SSZ(2),SSZ(7),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL V00023(SSZ(2),SSZ(7),SSZ(1))
      REAL U00025(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VDFANC"'
      CurrentAction2=
     *  'at line 579 in the TAB file'
      CurrentIGNO=130
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFANC"',
     *  'at line 579 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00025(I00001,I00004,I00002)=C00025(I00001,I00004,I00002)*
     *  (V00023(I00001,I00004,I00002)/100.0 +V00005(SSMP(SSMPST(9)-1+
     *  SSMP(SSMPST(3)-1+I00001)),I00002)/100.0 +
     *  V00022(I00001,I00004,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VDFANC"',
     *  'at line 579 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00025),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(25),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00025,U00025,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,25,
     *  ' while completing update of coefficient "VDFANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01399')
      RETURN
      END
      SUBROUTINE S01400(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00026,
     *  V00024,V00025,
     *  U00026,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00026(SSZ(2),SSZ(7),SSZ(1))
      REAL V00024(SSZ(2),SSZ(7),SSZ(1))
      REAL V00025(SSZ(2),SSZ(7),SSZ(1))
      REAL U00026(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VIFA"'
      CurrentAction2=
     *  'at line 590 in the TAB file'
      CurrentIGNO=135
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFA"',
     *  'at line 590 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00026(I00001,I00004,I00002)=C00026(I00001,I00004,I00002)*
     *  (V00024(I00001,I00004,I00002)/100.0 +
     *  V00025(I00001,I00004,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VIFA"',
     *  'at line 590 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00026),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(26),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00026,U00026,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,26,
     *  ' while completing update of coefficient "VIFA"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01400')
      RETURN
      END
      SUBROUTINE S01401(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00027,
     *  V00009,V00025,V00026,
     *  U00027,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00027(SSZ(2),SSZ(7),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00025(SSZ(2),SSZ(7),SSZ(1))
      REAL V00026(SSZ(2),SSZ(7),SSZ(1))
      REAL U00027(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VIFANC"'
      CurrentAction2=
     *  'at line 600 in the TAB file'
      CurrentIGNO=139
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFANC"',
     *  'at line 600 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00027(I00001,I00004,I00002)=C00027(I00001,I00004,I00002)*
     *  (V00026(I00001,I00004,I00002)/100.0 +
     *  V00009(I00001,I00002)/100.0 +
     *  V00025(I00001,I00004,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VIFANC"',
     *  'at line 600 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00027),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(27),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00027,U00027,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,27,
     *  ' while completing update of coefficient "VIFANC"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01401')
      RETURN
      END
      SUBROUTINE S01402(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00028,
     *  V00005,V00020,V00027,
     *  U00028,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00028(SSZ(6),SSZ(7),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00020(SSZ(6),SSZ(7),SSZ(1))
      REAL V00027(SSZ(10),SSZ(7),SSZ(1))
      REAL U00028(SSZ(6),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VFM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPCVAR(
     *  SSZ(6),SSZ(7),SSZ(1),1,
     *  1,1,1,
     *  U00028,0.0,1,1,1,1,1,1,1,
     *  SSZ(6),SSZ(7),SSZ(1),1,
     *  1,1,1,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VFM"'
      CurrentAction2=
     *  'at line 609 in the TAB file'
      CurrentIGNO=143
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VFM"',
     *  'at line 609 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(11)  ! (all,i,ENDWM_COMM)
      U00028(SSMP(SSMPST(11)-1+I00001),I00004,I00002)=
     *  C00028(SSMP(SSMPST(11)-1+I00001),I00004,I00002)*
     *  (V00005(SSMP(SSMPST(7)-1+SSMP(SSMPST(5)-1+SSMP(SSMPST(11)-1+
     *  I00001))),I00002)/100.0 +V00020(SSMP(SSMPST(11)-1+
     *  I00001),I00004,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,ENDWM_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VFM"',
     *  'at line 609 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VFM"'
      CurrentAction2=
     *  'at line 611 in the TAB file'
      CurrentIGNO=144
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VFM"',
     *  'at line 611 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 6 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 5 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 4 I00001=1,SSZ(10)  ! (all,i,ENDWS_COMM)
      U00028(SSMP(SSMPST(10)-1+I00001),I00004,I00002)=
     *  C00028(SSMP(SSMPST(10)-1+I00001),I00004,I00002)*
     *  (V00027(I00001,I00004,I00002)/100.0 +V00020(SSMP(SSMPST(10)-1+
     *  I00001),I00004,I00002)/100.0 )
    4 CONTINUE  ! END (all,i,ENDWS_COMM)
    5 CONTINUE  ! END (all,j,PROD_COMM)
    6 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VFM"',
     *  'at line 611 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00028),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(28),KSTEP,NSTEP,METHOD,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(6),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00028,U00028,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,28,
     *  ' while completing update of coefficient "VFM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01402')
      RETURN
      END
      SUBROUTINE S01403(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00029,
     *  V00009,V00025,
     *  U00029,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00029(SSZ(2),SSZ(7),SSZ(1))
      REAL V00009(SSZ(2),SSZ(1))
      REAL V00025(SSZ(2),SSZ(7),SSZ(1))
      REAL U00029(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VIFM"'
      CurrentAction2=
     *  'at line 618 in the TAB file'
      CurrentIGNO=147
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIFM"',
     *  'at line 618 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00029(I00001,I00004,I00002)=C00029(I00001,I00004,I00002)*
     *  (V00009(I00001,I00002)/100.0 +
     *  V00025(I00001,I00004,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VIFM"',
     *  'at line 618 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00029),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(29),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00029,U00029,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,29,
     *  ' while completing update of coefficient "VIFM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01403')
      RETURN
      END
      SUBROUTINE S01404(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00030,
     *  V00005,V00022,
     *  U00030,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00030(SSZ(2),SSZ(7),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00022(SSZ(2),SSZ(7),SSZ(1))
      REAL U00030(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VDFM"'
      CurrentAction2=
     *  'at line 625 in the TAB file'
      CurrentIGNO=150
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDFM"',
     *  'at line 625 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00030(I00001,I00004,I00002)=C00030(I00001,I00004,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00022(I00001,I00004,I00002)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VDFM"',
     *  'at line 625 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00030),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(30),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00030,U00030,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,30,
     *  ' while completing update of coefficient "VDFM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01404')
      RETURN
      END
      SUBROUTINE S01405(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00031,
     *  V00028,V00029,
     *  U00031,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00031(SSZ(1))
      REAL V00028(SSZ(1))
      REAL V00029(SSZ(1))
      REAL U00031(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDEP"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VDEP"'
      CurrentAction2=
     *  'at line 642 in the TAB file'
      CurrentIGNO=155
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VDEP"',
     *  'at line 642 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00031(I00002)=C00031(I00002)*(V00028(I00002)/100.0 +
     *  V00029(I00002)/100.0 )
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VDEP"',
     *  'at line 642 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00031),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(31),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00031,U00031,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,31,
     *  ' while completing update of coefficient "VDEP"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01405')
      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.
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VERNUM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01380(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  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
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'SAVE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01383(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00009,
     *  V00001,V00002,
     *  U00009,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDGA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01384(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00010,
     *  V00003,V00004,
     *  U00010,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00010),U00010,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDGANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01385(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00011,
     *  V00004,V00005,V00006,
     *  U00011,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00011),U00011,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDGM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01386(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00012,
     *  V00004,V00005,
     *  U00012,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00012),U00012,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIGA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01387(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00013,
     *  V00007,V00008,
     *  U00013,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00013),U00013,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIGANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01388(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00014,
     *  V00008,V00009,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''',
     *    'VIGM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01389(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00015,
     *  V00008,V00009,
     *  U00015,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00015),U00015,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDPA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01390(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00016,
     *  V00011,V00012,
     *  U00016,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00016),U00016,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDPANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01391(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00017,
     *  V00005,V00012,V00013,
     *  U00017,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00017),U00017,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDPM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01392(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00018,
     *  V00005,V00012,
     *  U00018,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00018),U00018,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIPA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01393(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00019,
     *  V00014,V00015,
     *  U00019,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00019),U00019,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIPANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01394(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00020,
     *  V00009,V00015,V00016,
     *  U00020,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00020),U00020,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIPM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01395(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00021,
     *  V00009,V00015,
     *  U00021,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00021),U00021,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'EVOA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01396(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00022,
     *  V00017,V00018,
     *  U00022,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00022),U00022,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'EVFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01397(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00023,
     *  V00019,V00020,
     *  U00023,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00023),U00023,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01398(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00024,
     *  V00021,V00022,
     *  U00024,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00024),U00024,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDFANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01399(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00025,
     *  V00005,V00022,V00023,
     *  U00025,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00025),U00025,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIFA',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01400(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00026,
     *  V00024,V00025,
     *  U00026,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00026),U00026,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIFANC',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01401(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00027,
     *  V00009,V00025,V00026,
     *  U00027,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00027),U00027,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VFM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VFM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01402(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00028,
     *  V00005,V00020,V00027,
     *  U00028,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00028),U00028,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIFM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01403(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00029,
     *  V00009,V00025,
     *  U00029,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00029),U00029,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDFM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01404(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00030,
     *  V00005,V00022,
     *  U00030,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00030),U00030,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VDEP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01405(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00031,
     *  V00028,V00029,
     *  U00031,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('M00035')
      RETURN
      END
      SUBROUTINE S01406(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00032,
     *  V00030,V00031,
     *  U00032,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00032(SSZ(2),SSZ(1),SSZ(1))
      REAL V00030(SSZ(2),SSZ(1),SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL U00032(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIMS"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VIMS"'
      CurrentAction2=
     *  'at line 663 in the TAB file'
      CurrentIGNO=160
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIMS"',
     *  'at line 663 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00032(I00001,I00002,I00003)=C00032(I00001,I00002,I00003)*
     *  (V00030(I00001,I00002,I00003)/100.0 +
     *  V00031(I00001,I00002,I00003)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VIMS"',
     *  'at line 663 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00032),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(32),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00032,U00032,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,32,
     *  ' while completing update of coefficient "VIMS"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01406')
      RETURN
      END
      SUBROUTINE S01407(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00033,
     *  V00031,V00032,
     *  U00033,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00033(SSZ(2),SSZ(1),SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00032(SSZ(2),SSZ(1),SSZ(1))
      REAL U00033(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIWS"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VIWS"'
      CurrentAction2=
     *  'at line 672 in the TAB file'
      CurrentIGNO=164
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VIWS"',
     *  'at line 672 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00033(I00001,I00002,I00003)=C00033(I00001,I00002,I00003)*
     *  (V00032(I00001,I00002,I00003)/100.0 +
     *  V00031(I00001,I00002,I00003)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VIWS"',
     *  'at line 672 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00033),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(33),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00033,U00033,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,33,
     *  ' while completing update of coefficient "VIWS"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01407')
      RETURN
      END
      SUBROUTINE S01408(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00034,
     *  V00031,V00033,
     *  U00034,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00034(SSZ(2),SSZ(1),SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL V00033(SSZ(2),SSZ(1),SSZ(1))
      REAL U00034(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VXWD"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VXWD"'
      CurrentAction2=
     *  'at line 681 in the TAB file'
      CurrentIGNO=168
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VXWD"',
     *  'at line 681 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00034(I00001,I00002,I00003)=C00034(I00001,I00002,I00003)*
     *  (V00033(I00001,I00002,I00003)/100.0 +
     *  V00031(I00001,I00002,I00003)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VXWD"',
     *  'at line 681 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00034),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(34),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00034,U00034,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,34,
     *  ' while completing update of coefficient "VXWD"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01408')
      RETURN
      END
      SUBROUTINE S01409(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00035,
     *  V00005,V00031,
     *  U00035,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00035(SSZ(2),SSZ(1),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00031(SSZ(2),SSZ(1),SSZ(1))
      REAL U00035(SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VXMD"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VXMD"'
      CurrentAction2=
     *  'at line 689 in the TAB file'
      CurrentIGNO=171
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VXMD"',
     *  'at line 689 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00035(I00001,I00002,I00003)=C00035(I00001,I00002,I00003)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+
     *  I00001)),I00002)/100.0 +V00031(I00001,I00002,I00003)/100.0 )
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
    3 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VXMD"',
     *  'at line 689 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00035),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(35),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),SSZ(1),1,
     *    1,1,1,
     *    C00035,U00035,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,35,
     *  ' while completing update of coefficient "VXMD"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01409')
      RETURN
      END
      SUBROUTINE S01410(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00036,
     *  V00005,V00034,
     *  U00036,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00036(SSZ(3),SSZ(1))
      REAL V00005(SSZ(9),SSZ(1))
      REAL V00034(SSZ(3),SSZ(1))
      REAL U00036(SSZ(3),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VST"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VST"'
      CurrentAction2=
     *  'at line 699 in the TAB file'
      CurrentIGNO=175
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VST"',
     *  'at line 699 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      U00036(I00005,I00002)=C00036(I00005,I00002)*
     *  (V00005(SSMP(SSMPST(9)-1+SSMP(SSMPST(3)-1+SSMP(SSMPST(1)-1+
     *  I00005))),I00002)/100.0 +V00034(I00005,I00002)/100.0 )
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VST"',
     *  'at line 699 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00036),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(36),KSTEP,NSTEP,METHOD,
     *    SSZ(3),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(3),SSZ(1),1,1,
     *    1,1,1,
     *    C00036,U00036,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,36,
     *  ' while completing update of coefficient "VST"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01410')
      RETURN
      END
      SUBROUTINE S01411(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00037,
     *  V00035,
     *  U00037,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00037(SSZ(2),SSZ(7),SSZ(1))
      REAL V00035(SSZ(2),SSZ(7),SSZ(1))
      REAL U00037(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2DF"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "CO2DF"'
      CurrentAction2=
     *  'at line 717 in the TAB file'
      CurrentIGNO=179
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2DF"',
     *  'at line 717 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00037(I00001,I00004,I00002)=C00037(I00001,I00004,I00002)*
     *  V00035(I00001,I00004,I00002)/100.0
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "CO2DF"',
     *  'at line 717 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00037),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(37),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00037,U00037,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,37,
     *  ' while completing update of coefficient "CO2DF"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01411')
      RETURN
      END
      SUBROUTINE S01412(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00038,
     *  V00036,
     *  U00038,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00004
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00038(SSZ(2),SSZ(7),SSZ(1))
      REAL V00036(SSZ(2),SSZ(7),SSZ(1))
      REAL U00038(SSZ(2),SSZ(7),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2IF"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "CO2IF"'
      CurrentAction2=
     *  'at line 728 in the TAB file'
      CurrentIGNO=183
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2IF"',
     *  'at line 728 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00004=1,SSZ(7)  ! (all,j,PROD_COMM)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00038(I00001,I00004,I00002)=C00038(I00001,I00004,I00002)*
     *  V00036(I00001,I00004,I00002)/100.0
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,j,PROD_COMM)
    3 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "CO2IF"',
     *  'at line 728 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00038),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(38),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    SSZ(2),SSZ(7),SSZ(1),1,
     *    1,1,1,
     *    C00038,U00038,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,38,
     *  ' while completing update of coefficient "CO2IF"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01412')
      RETURN
      END
      SUBROUTINE S01413(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00039,
     *  V00037,
     *  U00039,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00039(SSZ(2),SSZ(1))
      REAL V00037(SSZ(2),SSZ(1))
      REAL U00039(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2DG"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "CO2DG"'
      CurrentAction2=
     *  'at line 740 in the TAB file'
      CurrentIGNO=187
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2DG"',
     *  'at line 740 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00039(I00001,I00002)=C00039(I00001,I00002)*
     *  V00037(I00001,I00002)/100.0
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "CO2DG"',
     *  'at line 740 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00039),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(39),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00039,U00039,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,39,
     *  ' while completing update of coefficient "CO2DG"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01413')
      RETURN
      END
      SUBROUTINE S01414(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00040,
     *  V00038,
     *  U00040,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00040(SSZ(2),SSZ(1))
      REAL V00038(SSZ(2),SSZ(1))
      REAL U00040(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2IG"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "CO2IG"'
      CurrentAction2=
     *  'at line 751 in the TAB file'
      CurrentIGNO=191
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2IG"',
     *  'at line 751 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00040(I00001,I00002)=C00040(I00001,I00002)*
     *  V00038(I00001,I00002)/100.0
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "CO2IG"',
     *  'at line 751 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00040),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(40),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00040,U00040,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,40,
     *  ' while completing update of coefficient "CO2IG"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01414')
      RETURN
      END
      SUBROUTINE S01415(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00041,
     *  V00039,
     *  U00041,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00041(SSZ(2),SSZ(1))
      REAL V00039(SSZ(2),SSZ(1))
      REAL U00041(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2DP"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "CO2DP"'
      CurrentAction2=
     *  'at line 763 in the TAB file'
      CurrentIGNO=195
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2DP"',
     *  'at line 763 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00041(I00001,I00002)=C00041(I00001,I00002)*
     *  V00039(I00001,I00002)/100.0
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "CO2DP"',
     *  'at line 763 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00041),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(41),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00041,U00041,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,41,
     *  ' while completing update of coefficient "CO2DP"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01415')
      RETURN
      END
      SUBROUTINE S01416(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00042,
     *  V00040,
     *  U00042,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00042(SSZ(2),SSZ(1))
      REAL V00040(SSZ(2),SSZ(1))
      REAL U00042(SSZ(2),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2IP"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "CO2IP"'
      CurrentAction2=
     *  'at line 774 in the TAB file'
      CurrentIGNO=199
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2IP"',
     *  'at line 774 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      U00042(I00001,I00002)=C00042(I00001,I00002)*
     *  V00040(I00001,I00002)/100.0
    1 CONTINUE  ! END (all,i,TRAD_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "CO2IP"',
     *  'at line 774 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00042),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(42),KSTEP,NSTEP,METHOD,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(2),SSZ(1),1,1,
     *    1,1,1,
     *    C00042,U00042,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,42,
     *  ' while completing update of coefficient "CO2IP"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01416')
      RETURN
      END
      SUBROUTINE S01417(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00043,
     *  V00041,
     *  U00043,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      INTEGER C00008(SSZ(1))
      REAL C00043(SSZ(1))
      REAL V00041(SSZ(17))
      REAL U00043(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "NCTAXLEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "NCTAXLEV"'
      CurrentAction2=
     *  'at line 788 in the TAB file'
      CurrentIGNO=203
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "NCTAXLEV"',
     *  'at line 788 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00043(I00002)=V00041(C00008(I00002))
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "NCTAXLEV"',
     *  'at line 788 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00043),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(43),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00043,U00043,RWORK,.TRUE.,'c',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,43,
     *  ' while completing update of coefficient "NCTAXLEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01417')
      RETURN
      END
      SUBROUTINE S01435(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00155,
     *  V00028,V00029,
     *  U00155,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00155(SSZ(1))
      REAL V00028(SSZ(1))
      REAL V00029(SSZ(1))
      REAL U00155(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VKB"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VKB"'
      CurrentAction2=
     *  'at line 2691 in the TAB file'
      CurrentIGNO=708
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VKB"',
     *  'at line 2691 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00155(I00002)=C00155(I00002)*(V00029(I00002)/100.0 +
     *  V00028(I00002)/100.0 )
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VKB"',
     *  'at line 2691 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00155),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(155),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00155,U00155,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,155,
     *  ' while completing update of coefficient "VKB"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01435')
      RETURN
      END
      SUBROUTINE S01439(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00162,
     *  V00111,V00120,
     *  U00162,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER I00003
      INTEGER I00005
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00111(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      REAL V00120(SSZ(3))
      REAL U00162(SSZ(3),SSZ(2),SSZ(1),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VTMFSD"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VTMFSD"'
      CurrentAction2=
     *  'at line 3034 in the TAB file'
      CurrentIGNO=757
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VTMFSD"',
     *  'at line 3034 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 4 I00003=1,SSZ(1)  ! (all,s,REG)
      DO 3 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 2 I00001=1,SSZ(2)  ! (all,i,TRAD_COMM)
      DO 1 I00005=1,SSZ(3)  ! (all,m,MARG_COMM)
      U00162(I00005,I00001,I00002,I00003)=
     *  C00162(I00005,I00001,I00002,I00003)*(V00120(I00005)/100.0 +
     *  V00111(I00005,I00001,I00002,I00003)/100.0 )
    1 CONTINUE  ! END (all,m,MARG_COMM)
    2 CONTINUE  ! END (all,i,TRAD_COMM)
    3 CONTINUE  ! END (all,r,REG)
    4 CONTINUE  ! END (all,s,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VTMFSD"',
     *  'at line 3034 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00162),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(162),KSTEP,NSTEP,METHOD,
     *    SSZ(3),SSZ(2),SSZ(1),SSZ(1),
     *    1,1,1,
     *    SSZ(3),SSZ(2),SSZ(1),SSZ(1),
     *    1,1,1,
     *    C00162,U00162,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,162,
     *  ' while completing update of coefficient "VTMFSD"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01439')
      RETURN
      END
      SUBROUTINE S01440(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00175,
     *  V00121,
     *  U00175,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00175(SSZ(1))
      REAL V00121(SSZ(1))
      REAL U00175(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2Q"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "CO2Q"'
      CurrentAction2=
     *  'at line 3216 in the TAB file'
      CurrentIGNO=795
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CO2Q"',
     *  'at line 3216 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00175(I00002)=C00175(I00002)*V00121(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "CO2Q"',
     *  'at line 3216 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00175),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(175),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00175,U00175,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,175,
     *  ' while completing update of coefficient "CO2Q"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01440')
      RETURN
      END
      SUBROUTINE M00036(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,RTSIOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,NELTX,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c1
      USE gtap_u1
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL LDOWR,NELTX,RTSIOK
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOGICAL CPDOAC,CPDOAP
      COMMON/CPLOG1/ CPDOAC,CPDOAP
      DOUBLE PRECISION CPSLEN,CPSDON,CPSTOT
      COMMON /CPDBL2/ CPSLEN,CPSDON,CPSTOT
      LOGICAL CPSKAC
      COMMON /CPLOG7/CPSKAC
      INTEGER :: LDSPDEC,LDSPCPN,LDSPCLN
      LDOWR=(KSTEPA.EQ.NPASSA).AND.(.NOT.CPDOAP)
      IF(CPDOAP.AND.CPSKAC) LDOWR=(CPSTOT.EQ.1.0D0)
      LOWMEM=.FALSE.
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00031),U00031,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIMS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01406(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00032,
     *  V00030,V00031,
     *  U00032,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00032),U00032,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VIWS',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01407(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00033,
     *  V00031,V00032,
     *  U00033,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00033),U00033,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VXWD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01408(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00034,
     *  V00031,V00033,
     *  U00034,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00034),U00034,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VXMD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01409(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00035,
     *  V00005,V00031,
     *  U00035,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00035),U00035,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VST',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01410(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00036,
     *  V00005,V00034,
     *  U00036,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00036),U00036,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2DF',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01411(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00037,
     *  V00035,
     *  U00037,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00037),U00037,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2IF',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01412(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00038,
     *  V00036,
     *  U00038,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00038),U00038,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2DG',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01413(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00039,
     *  V00037,
     *  U00039,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00039),U00039,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2IG',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01414(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00040,
     *  V00038,
     *  U00040,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00040),U00040,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2DP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01415(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00041,
     *  V00039,
     *  U00041,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00041),U00041,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2IP',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01416(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00042,
     *  V00040,
     *  U00042,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00042),U00042,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'NCTAXLEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01417(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00008,C00043,
     *  V00041,
     *  U00043,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VKB',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01435(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00155,
     *  V00028,V00029,
     *  U00155,
     *  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(U00155),U00155,
     *  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''',
     *    'VTMFSD',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01439(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00162,
     *  V00111,V00120,
     *  U00162,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00162),U00162,
     *  MMNCS,NUMCS,CSNAM,CSNIND,CSPOSTSIM,
     *  MMNST,SSZ,SZUB,ELAD,STELST,STNM,MMEL,STEL,
     *  AUTACC,POSTSIMPASS3,SILEN,MINSIL,MINSFL,UDRTST,INRTST,
     *  MMDEBG,DEBG,RTSIOK,CONTSI,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(.NOT.CONTSI) RETURN
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'CO2Q',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01440(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00175,
     *  V00121,
     *  U00175,
     *  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('M00036')
      RETURN
      END
      SUBROUTINE S01442(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00183,
     *  V00043,
     *  U00183,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00183(SSZ(1))
      REAL V00043(SSZ(1))
      REAL U00183(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "PIND"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "PIND"'
      CurrentAction2=
     *  'at line 3417 in the TAB file'
      CurrentIGNO=841
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "PIND"',
     *  'at line 3417 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00183(I00002)=C00183(I00002)*V00043(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "PIND"',
     *  'at line 3417 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00183),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(183),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00183,U00183,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,183,
     *  ' while completing update of coefficient "PIND"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01442')
      RETURN
      END
      SUBROUTINE S01443(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00185,
     *  V00133,
     *  U00185,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00006
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00185(SSZ(17))
      REAL V00133(SSZ(17))
      REAL U00185(SSZ(17))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "PINDB"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "PINDB"'
      CurrentAction2=
     *  'at line 3442 in the TAB file'
      CurrentIGNO=851
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "PINDB"',
     *  'at line 3442 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00006=1,SSZ(17)  ! (all,b,BLOC)
      U00185(I00006)=C00185(I00006)*V00133(I00006)/100.0
    1 CONTINUE  ! END (all,b,BLOC)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "PINDB"',
     *  'at line 3442 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00185),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(185),KSTEP,NSTEP,METHOD,
     *    SSZ(17),1,1,1,
     *    1,1,1,
     *    SSZ(17),1,1,1,
     *    1,1,1,
     *    C00185,U00185,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,185,
     *  ' while completing update of coefficient "PINDB"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01443')
      RETURN
      END
      SUBROUTINE S01444(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00187,
     *  V00135,
     *  U00187,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00187(SSZ(1))
      REAL V00135(SSZ(1))
      REAL U00187(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CTGSHARE"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "CTGSHARE"'
      CurrentAction2=
     *  'at line 3461 in the TAB file'
      CurrentIGNO=859
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "CTGSHARE"',
     *  'at line 3461 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00187(I00002)=V00135(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "CTGSHARE"',
     *  'at line 3461 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00187),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(187),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00187,U00187,RWORK,.TRUE.,'c',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,187,
     *  ' while completing update of coefficient "CTGSHARE"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01444')
      RETURN
      END
      SUBROUTINE S01445(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00190,
     *  V00143,
     *  U00190,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00190(SSZ(1))
      REAL V00143(SSZ(1))
      REAL U00190(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "DPARSUM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "DPARSUM"'
      CurrentAction2=
     *  'at line 3613 in the TAB file'
      CurrentIGNO=887
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "DPARSUM"',
     *  'at line 3613 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00190(I00002)=C00190(I00002)*V00143(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "DPARSUM"',
     *  'at line 3613 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00190),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(190),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00190,U00190,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,190,
     *  ' while completing update of coefficient "DPARSUM"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01445')
      RETURN
      END
      SUBROUTINE S01446(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00195,
     *  V00053,
     *  U00195,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00195(SSZ(1))
      REAL V00053(SSZ(1))
      REAL U00195(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILPRIV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "UTILPRIV"'
      CurrentAction2=
     *  'at line 3641 in the TAB file'
      CurrentIGNO=899
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILPRIV"',
     *  'at line 3641 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00195(I00002)=C00195(I00002)*V00053(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "UTILPRIV"',
     *  'at line 3641 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00195),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(195),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00195,U00195,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,195,
     *  ' while completing update of coefficient "UTILPRIV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01446')
      RETURN
      END
      SUBROUTINE S01447(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00196,
     *  V00049,
     *  U00196,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00196(SSZ(1))
      REAL V00049(SSZ(1))
      REAL U00196(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILGOV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "UTILGOV"'
      CurrentAction2=
     *  'at line 3648 in the TAB file'
      CurrentIGNO=903
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILGOV"',
     *  'at line 3648 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00196(I00002)=C00196(I00002)*V00049(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "UTILGOV"',
     *  'at line 3648 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00196),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(196),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00196,U00196,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,196,
     *  ' while completing update of coefficient "UTILGOV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01447')
      RETURN
      END
      SUBROUTINE S01448(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00197,
     *  V00002,V00044,
     *  U00197,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00197(SSZ(1))
      REAL V00002(SSZ(1))
      REAL V00044(SSZ(1))
      REAL U00197(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILSAVE"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "UTILSAVE"'
      CurrentAction2=
     *  'at line 3655 in the TAB file'
      CurrentIGNO=907
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILSAVE"',
     *  'at line 3655 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00197(I00002)=((V00002(I00002)-V00044(I00002))/100.)*
     *  C00197(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "UTILSAVE"',
     *  'at line 3655 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00197),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(197),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00197,U00197,RWORK,.TRUE.,'c',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,197,
     *  ' while completing update of coefficient "UTILSAVE"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01448')
      RETURN
      END
      SUBROUTINE S01449(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00226,
     *  V00200,
     *  U00226,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00226(SSZ(1))
      REAL V00200(SSZ(1))
      REAL U00226(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "INCOMEEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "INCOMEEV"'
      CurrentAction2=
     *  'at line 4554 in the TAB file'
      CurrentIGNO=1087
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "INCOMEEV"',
     *  'at line 4554 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00226(I00002)=C00226(I00002)*V00200(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "INCOMEEV"',
     *  'at line 4554 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00226),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(226),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,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
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,226,
     *  ' while completing update of coefficient "INCOMEEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01449')
      RETURN
      END
      SUBROUTINE S01450(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00227,
     *  V00198,
     *  U00227,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00227(SSZ(1))
      REAL V00198(SSZ(1))
      REAL U00227(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILPRIVEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "UTILPRIVEV"'
      CurrentAction2=
     *  'at line 4561 in the TAB file'
      CurrentIGNO=1091
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILPRIVEV"',
     *  'at line 4561 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00227(I00002)=C00227(I00002)*V00198(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "UTILPRIVEV"',
     *  'at line 4561 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00227),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(227),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00227,U00227,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,227,
     *  ' while completing update of coefficient "UTILPRIVEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01450')
      RETURN
      END
      SUBROUTINE S01451(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00228,
     *  V00197,
     *  U00228,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00228(SSZ(1))
      REAL V00197(SSZ(1))
      REAL U00228(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILGOVEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "UTILGOVEV"'
      CurrentAction2=
     *  'at line 4568 in the TAB file'
      CurrentIGNO=1095
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILGOVEV"',
     *  'at line 4568 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00228(I00002)=C00228(I00002)*V00197(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "UTILGOVEV"',
     *  'at line 4568 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00228),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(228),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00228,U00228,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,228,
     *  ' while completing update of coefficient "UTILGOVEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01451')
      RETURN
      END
      SUBROUTINE S01452(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00229,
     *  V00044,V00199,
     *  U00229,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00229(SSZ(1))
      REAL V00044(SSZ(1))
      REAL V00199(SSZ(1))
      REAL U00229(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILSAVEEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "UTILSAVEEV"'
      CurrentAction2=
     *  'at line 4575 in the TAB file'
      CurrentIGNO=1099
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILSAVEEV"',
     *  'at line 4575 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00229(I00002)=((V00199(I00002)-V00044(I00002))/100.)*
     *  C00229(I00002)
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "UTILSAVEEV"',
     *  'at line 4575 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00229),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(229),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00229,U00229,RWORK,.TRUE.,'c',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,229,
     *  ' while completing update of coefficient "UTILSAVEEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01452')
      RETURN
      END
      SUBROUTINE S01453(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00230,
     *  V00203,
     *  U00230,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00001
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00230(SSZ(32),SSZ(1))
      REAL V00203(SSZ(32),SSZ(1))
      REAL U00230(SSZ(32),SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VPAEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "VPAEV"'
      CurrentAction2=
     *  'at line 4604 in the TAB file'
      CurrentIGNO=1105
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "VPAEV"',
     *  'at line 4604 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 2 I00002=1,SSZ(1)  ! (all,r,REG)
      DO 1 I00001=1,SSZ(32)  ! (all,i,UP_COMM)
      U00230(I00001,I00002)=C00230(I00001,I00002)*
     *  V00203(I00001,I00002)/100.0
    1 CONTINUE  ! END (all,i,UP_COMM)
    2 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "VPAEV"',
     *  'at line 4604 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00230),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(230),KSTEP,NSTEP,METHOD,
     *    SSZ(32),SSZ(1),1,1,
     *    1,1,1,
     *    SSZ(32),SSZ(1),1,1,
     *    1,1,1,
     *    C00230,U00230,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,230,
     *  ' while completing update of coefficient "VPAEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01453')
      RETURN
      END
      SUBROUTINE S01454(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00236,
     *  V00201,
     *  U00236,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00236(SSZ(1))
      REAL V00201(SSZ(1))
      REAL U00236(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "PRIVEXPEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "PRIVEXPEV"'
      CurrentAction2=
     *  'at line 4680 in the TAB file'
      CurrentIGNO=1123
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "PRIVEXPEV"',
     *  'at line 4680 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00236(I00002)=C00236(I00002)*V00201(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "PRIVEXPEV"',
     *  'at line 4680 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00236),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(236),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,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
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,236,
     *  ' while completing update of coefficient "PRIVEXPEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01454')
      RETURN
      END
      SUBROUTINE S01455(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00237,
     *  V00202,
     *  U00237,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00237(SSZ(1))
      REAL V00202(SSZ(1))
      REAL U00237(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "GOVEXPEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "GOVEXPEV"'
      CurrentAction2=
     *  'at line 4691 in the TAB file'
      CurrentIGNO=1127
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "GOVEXPEV"',
     *  'at line 4691 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00237(I00002)=C00237(I00002)*V00202(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "GOVEXPEV"',
     *  'at line 4691 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00237),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(237),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00237,U00237,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,237,
     *  ' while completing update of coefficient "GOVEXPEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01455')
      RETURN
      END
      SUBROUTINE S01456(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00238,
     *  V00204,
     *  U00238,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00238(SSZ(1))
      REAL V00204(SSZ(1))
      REAL U00238(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "SAVEEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "SAVEEV"'
      CurrentAction2=
     *  'at line 4699 in the TAB file'
      CurrentIGNO=1131
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "SAVEEV"',
     *  'at line 4699 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00238(I00002)=C00238(I00002)*V00204(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "SAVEEV"',
     *  'at line 4699 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00238),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(238),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    C00238,U00238,RWORK,.TRUE.,'p',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPDRW(ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,238,
     *  ' while completing update of coefficient "SAVEEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01456')
      RETURN
      END
      SUBROUTINE S01457(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00242,
     *  V00195,
     *  U00242,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      USE PSIMMOD1
      USE ARITHERROR
      USE GPRWK
      INTEGER MMNSS,SSIOS(MMNSS),SSMPST(MMNSS+1),DSSMP,SSMP(DSSMP)
      INTEGER AXSUN
      INTEGER I00002
      INTEGER MMNST,SSZ(MMNST),STIST(MMNST),IER,KK
      LOGICAL LGX
      LOGICAL ECHO1
      REAL C00242(SSZ(1))
      REAL V00195(SSZ(1))
      REAL U00242(SSZ(1))
      INTEGER DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS(MMNCS)
      CHARACTER*(*) METHOD
      CHARACTER*(*) ERRMES
      REAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL ID01,ID0V,GPRAND,TGFCMN,TGFNOR,TGFRAS
      EXTERNAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      REAL TGERF,TGERFCC,TGFLNOR,TGFCMLN
      EXTERNAL GPINTOP, TGIINSNewPOS
      INTEGER GPINTOP, TGIINSNewPOS
      IER=0
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILELASEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== new TBCDEU code =========
      CurrentAction=
     *  'update of coefficient "UTILELASEV"'
      CurrentAction2=
     *  'at line 4763 in the TAB file'
      CurrentIGNO=1148
      CurrentIGTP='ud'
      CALL GPAPRW(
     *  ' before calculating update of coefficient "UTILELASEV"',
     *  'at line 4763 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      ! ===== end TBCDEU code =========
      DO 1 I00002=1,SSZ(1)  ! (all,r,REG)
      U00242(I00002)=C00242(I00002)*V00195(I00002)/100.0
    1 CONTINUE  ! END (all,r,REG)
      IF(IER.NE.0) THEN
        CALL TGIER(IER,AXSUN,ERRMES)
        GOTO 15000
      END IF
      CALL GPAPRW2(.TRUE.,AXSUN,.FALSE.,0,
     *  ' while calculating update of coefficient "UTILELASEV"',
     *  'at line 4763 in the TAB file',ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL SKARB(AXSUN,1,FILPB,TFILPB,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL GPARW(SIZE(C00242),ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGUDA(DWKUN,DWKPOS(242),KSTEP,NSTEP,METHOD,
     *    SSZ(1),1,1,1,
     *    1,1,1,
     *    SSZ(1),1,1,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
      CALL GPAPRW2(.TRUE.,AXSUN,.TRUE.,242,
     *  ' while completing update of coefficient "UTILELASEV"',
     *  ' ',
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      RETURN
15000 CALL PERET('S01457')
      RETURN
      END
      SUBROUTINE M00037(RDUN,MMI,MMR,
     *  LFNORD,LFNOWR,LFFOWR,RDFSNO,WRFSNO,WTMO,
     *  KSINT,NSINT,KSINTA,
     *  RWA,NUMFL,
     *  IWA,RTSIOK,
     *  KMSTSL,AUTACC,SILEN,MINSIL,MINSFL,
     *  UDRTST,INRTST,CONTSI,
     *  DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA,
     *  AXSUN,AXTUN,WRUN,CWKUN,MMRDR,NELTX,
     *  CALC1,FSTPAS,CTRTHR,SUVFI,ERRMES)
      USE GSINC4
      USE GSINC7
      USE gtap_c1
      USE gtap_u1
      USE gtap_v1
      USE TGSMVL
      USE GSINC1
      USE GSINC5
      USE SMVLST0
      USE TGDEBG
      USE PSIMMOD1
      USE SIMRES0
      USE GSINC3
      USE GSINC6
      INTEGER MMI,MMR
      INTEGER RDUN,WRUN,CWKUN,MMRDR
      INTEGER NUMFL,AXSUN,AXTUN
      INTEGER KSINT,NSINT,KSINTA
      REAL RWA(DWA)
      INTEGER IWA(DIWA),TMPI1
      INTEGER KMSTSL
      LOGICAL AUTACC,CONTSI
      CHARACTER*(*) MINSFL,UDRTST,INRTST
      REAL MINSIL
      DOUBLE PRECISION SILEN
      INTEGER DRCOW
      PARAMETER(DRCOW=1)
      REAL RCOW(DRCOW)
      CHARACTER*(*) LFFOWR,WTMO
      CHARACTER*(*) ERRMES
      LOGICAL SKPSMD,LOWMEM,CALC1,FSTPAS,CTRTHR,SUVFI,TMPLG1
      LOGICAL LDOWR,NELTX,RTSIOK
      INTEGER LFNORD,LFNOWR,RDFSNO,WRFSNO
      INTEGER DWKUN,KSTEP,NSTEP,KSTEPA,NPASSA
      LOGICAL DOTHIS
      COMMON/DTHIS/DOTHIS
      LOGICAL CPDOAC,CPDOAP
      COMMON/CPLOG1/ CPDOAC,CPDOAP
      DOUBLE PRECISION CPSLEN,CPSDON,CPSTOT
      COMMON /CPDBL2/ CPSLEN,CPSDON,CPSTOT
      LOGICAL CPSKAC
      COMMON /CPLOG7/CPSKAC
      INTEGER :: LDSPDEC,LDSPCPN,LDSPCLN
      LDOWR=(KSTEPA.EQ.NPASSA).AND.(.NOT.CPDOAP)
      IF(CPDOAP.AND.CPSKAC) LDOWR=(CPSTOT.EQ.1.0D0)
      LOWMEM=.FALSE.
      CALL TGPCUV('tg',KSTEPA,KMSTSL,KSINTA,AXSUN,SIZE(U00175),U00175,
     *  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''',
     *    'PIND',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01442(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00183,
     *  V00043,
     *  U00183,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'PINDB',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01443(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00185,
     *  V00133,
     *  U00185,
     *  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''',
     *    'CTGSHARE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01444(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00187,
     *  V00135,
     *  U00187,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'DPARSUM',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01445(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00190,
     *  V00143,
     *  U00190,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILPRIV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01446(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00195,
     *  V00053,
     *  U00195,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILGOV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01447(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00196,
     *  V00049,
     *  U00196,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILSAVE',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01448(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00197,
     *  V00002,V00044,
     *  U00197,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'INCOMEEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01449(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00226,
     *  V00200,
     *  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
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILPRIVEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01450(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00227,
     *  V00198,
     *  U00227,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILGOVEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01451(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00228,
     *  V00197,
     *  U00228,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILSAVEEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01452(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00229,
     *  V00044,V00199,
     *  U00229,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'VPAEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01453(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00230,
     *  V00203,
     *  U00230,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'PRIVEXPEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01454(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00236,
     *  V00201,
     *  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
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'GOVEXPEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01455(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00237,
     *  V00202,
     *  U00237,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'SAVEEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01456(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00238,
     *  V00204,
     *  U00238,
     *  METHOD,DWKUN,KSTEP,NSTEP,MMNCS,DWKPOS,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      CALL TGSCRS('tg',1,CALC1,.FALSE.,LDOWR,CTRTHR,
     *  AXSUN,RDUN,WRUN,0,CWKUN,
     *  LFNORD,LFNOWR,LFFOWR,NUMFL,RDFSNO,WRFSNO,
     *  0,0,LDSPDEC,MMR,0,
     *  KSTEPA,NPASSA,KSINT,KSINTA,NSINT,
     *  .FALSE.,.FALSE.,WTMO,.FALSE.,
     *  .TRUE.,.TRUE.,.TRUE.,LDSPCPN,LDSPCLN,NELTX,
     *  SUVFI,
     *  TMPLG1,TMPI1,
     *  ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      IF(ECHO1) THEN
        CALL GPTO1(' Update of ''%t''',
     *    'UTILELASEV',0,ERRMES)
      IF(ERRMES(1:1).EQ.'E') GOTO 15000
      END IF
      CALL S01457(MMNSS,SSIOS,ECHO1,
     *  MMNST,SSZ,STIST,
     *  SSMPST,DSSMP,SSMP,AXSUN,
     *  C00242,
     *  V00195,
     *  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
      RETURN
15000 CALL PERET('M00037')
      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 'ssstuff.for'
      include 'tgscrs1.for'
      USE gtap_c3
      USE gtap_v5
      include 'tgscrs2.for'
      include 'tgwcvv1.for'
      USE gtap_c3
      USE gtap_u2
      USE gtap_v5
      include 'tgwcvv2.for'
      include 'tgutca1.for'
      USE gtap_c3
      include 'tgutca2.for'
      include 'tgcuvtv1.for'
      USE gtap_c3
      USE gtap_u2
      USE gtap_v5
      include 'tgcuvtv2.for'
      include 'tg1datcv1.for'
      USE gtap_c3
      USE gtap_v5
      include 'tg1datcv2.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'
